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 ({OeAIa3120?sڂcaɂ 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. # ---------------------- 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! # ---------------------- end------------------------ # # # ***STEP2: Embed into the header section # # Make a new CGI script as "header.cgi", and call it by SSI in webpages. # ---------------------- 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); # # ---------------------- end------------------------ # To call this from webpages, embed a line like following, to the head # section (...) of weblages: # > # > ... # > # > ... # > # # # ***STEP3: Embed the form to switch styles # # Make a new CGI script as "form.cgi" and call by SSI in weblages. # ---------------------- 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); # # ---------------------- end-------------------------- # To call this from webpages, embed a line like following, to the body # section (...) of weblages: # > # > ... # > # > ... # > # # # ***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. # #======================================================================= # gcu #======================================================================= # # SSS.jsIPerlAB # fpfbfP[fWEIAAPerl4^E?~IA?s‹aKvAB # # # !ݒeftf@fCfI?i # # ܂A^EoIaEaeIPerlfXfNffvfg??i܂B # ftf@fCf1͂EnAaccAaASSS.plAfffBfOfNfgf # ucĂA1A֗~AaB # A͗AāuSSSinit.plvAc1OAݒeftf@fCf??i # aIA1e܂B # ---------------------- start---------------------- # # # fXf^fCfIe` # &SSS'addStyle("style1", "/~piro/style1.css", "screen"); # &SSS'addStyle("style2", "/~piro/style2.css", "screen"); # # ^óufXf^fCf1vufV[fgIfpfXvuΉffffBfAvI?B # # fpfX́u\nvaOeA!we”\AffffBfAfJff}aOeAB # # i^e?A?IfXf^fCfaffftfHffgIfXf^fCfi?߂fy[fW? # # Jc1AɁA??ԂAI?3eĂcfXf^fCfjɂEe܂j # # fXf^fCf1??EaAAifXf^fCfɂEe܂B # # EAa4^oA0^EOIli1Eǁj?nAAIfXf^fCf # # OeւftfH[fI^eɕ\3eEEe܂iBfXf^fCfjB # # # ufXf^fCf3vI\1iffftfHffǵuNo Stylevj # $SSS'noStyleLabel = 'No Style'; # # # fXf^fCfI??nICookieIUpfpfXiffftfHffg͂Ify[fWIfpfXj # $SSS'targetRoot = '/~piro/'; # # # XHTMLIfy[fWɑ΂Ďgp?e?́u1vAHTMLÁu0v # # iffftfHffǵu0vj # $SSS'outputAsXHTML = 1; # # # I?3eE1fV[fg?afXf^fCffV[fgAfffN # # ?e?́u1vAEc?e?́u0viffftfHffǵu0vj # $SSS'shouldLinkAlternateStyleSheets = 1; # # IEA͑afXf^fCffV[fg܂ASǂ?nA܂IAA # # u0vɂĂEcAfy[fWIǂ?݂axE邱Aa e܂ # # # OeւftfH[fIݒe # $SSS'formLabel = 'SelectStyle:'; # ffXfgIffxf # $SSS'formAccessKey = 'S'; # ffXfgIfAfNfZfXfL[ # $SSS'applyLabel = 'Go!'; # A?sf{f^fIffxf # $SSS'applyAccessKey = 'G'; # A?sf{f^fIfAfNfZfXfL[ # # 1; # YeEcaɁI # ---------------------- end------------------------ # # # !headւI? # # ^EoIaEaeICGIfXfNffvfg??iA`IA # SSIAA?sĉo3cBA͉1Ɂuheader.cgivA܂B # ---------------------- start---------------------- # #!/usr/local/bin/perl # # iaPerlIfpfX͊‹?1ĉo3cj # # require "./SSS.pl"; # fpfbfP[fWIǂ? # require "./SSSinit.pl"; # ݒeftf@fCfIǂ? # # # ݒe?aA? # &SSS'initLinks(); # # # fXf^fCffV[fgIfffN??o # &SSS'writeLinks(); # # 1ICGIfXfNffvfgOĂN?o?e?́A^ou1v?‚A # # HTTPfwfbf_IContent-type??o͂܂1n # # &SSS'writeLinks(1); # # ---------------------- end------------------------ # # # !OeւftfH[fI? # # ^EoIaEfXfNffvfg?SSIAA?sAAI? # fXf^fCfOeւI1߂IftfH[fa\3e܂B # fXfNffvfg1́AA͉1Ɂuform.cgivA܂B # ---------------------- start------------------------ # #!/usr/local/bin/perl # # iaPerlIfpfX͊‹?1ĉo3cj # # require "./SSS.pl"; # fpfbfP[fWIǂ? # require "./SSSinit.pl"; # ݒeftf@fCfIǂ? # # # ݒe?aA? # &SSS'initForm(); # # # ftfH[f??o # &SSS'writeForm(); # # 1ICGIfXfNffvfgOĂN?o?e?́A^ou1v?‚A # # HTTPfwfbf_IContent-type??o͂܂1n # # &SSS'writeForm(1); # # ---------------------- end-------------------------- # # # !֗~Egcu # # &SSS'initLinks();IA?sOáA$SSS'styleSheetsLinks # &SSS'writeLinks();A?o͂aeai[3e܂B # ܂1A&SSS'initForm();IA?sOáA$SSS'form&SSS'writeForm();A # ?o͂ftfH[fai[3e܂BOf‚EǂICGIfXfNffvfgAg # ?1ĎgEǂɗ~pA܂B # # IfXfNffvfg?gpĂcfy[fW?u?SSSStyle=fXf^fCf1v # Ac^o?weēǂ??AAIɂIfXf^fCf?Kp܂B # ftfH[f?g킸fXf^fCfOeւ??sc1c?e?AIfXfNffvfgA # nY3eftfH[faCɓEc?e?Eǂɗ~pA܂B # #======================================================================= # # ⑫B # 1IfTfCfgAge?e?EǁA?ւIfffNa~?iO \aIa # ?ĔzzaSĎRA܂B # #======================================================================= # ?F # 2003/3/1 Ver.1.0 JavaScriptPerl^ڐA # 2003/3/1 Ver.1.1 ftfH[fI?u@?I?X # 2003/3/3 Ver.1.1.1 HTMLIf~fX??C3 # 2003/3/9 Ver.1.1.2 fffNI?o͂??C3 # 2003/3/21 Ver.1.1.3 f^fCfgfIEcfXf^fCffV[fg?ifXf^fCffV[fg # A?o͂aɂ1 # 2003/4/29 Ver.1.1.4 fXf^fCf?OeւffXfgBݒ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(); } #----------------------------------------------------------------------- # fffNI?o # [0] = f[fh 0:SSIp 1:fXfNffvfgaOĂN?oiContent-type??o͂Ecj #----------------------------------------------------------------------- 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?3e1fXf^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^fCffV[fgւIfffN? #----------------------------------------------------------------------- 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, ""); } } elsif ($ii == $selectedIndex) { @work = split(/\n/, $stylesPath[$ii]); foreach $work (@work) { push(@links, ""); } } elsif ($shouldLinkAlternateStyleSheets != 0) { @work = split(/\n/, $stylesPath[$ii]); foreach $work (@work) { push(@links, ""); } } $ii++; } $styleSheetsLinks = join("\n", @links); } #----------------------------------------------------------------------- # fXf^fCfe` # [0] = 1O # [1] = fV[fgIURIi\naOeA!wej # [2] = ffffBfA # [3] = ffXfgBǂi0EB3EcAe^EOEBj #----------------------------------------------------------------------- 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[fp $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_fEfffXfg? $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, ""); } if ($ii == $max-1 || $stylesGroup[$ii] ne $stylesGroup[$ii+1]) { $work = join("\n", @work); if ($stylesGroup[$ii] ne '') { $work = "\n$work\n"; } push(@option, $work); @work = (''); } } push(@option, ""); $options = join("\n", @option); if ($outputAsXHTML != 0) { $mSlashForXHTML = ' /'; } $form = <<________________________HTML_DATA________________________;
________________________HTML_DATA________________________ } # [0] = f[fh 0:SSIp 1:fXfNffvfgaOĂN?oiContent-type??o͂Ecj sub writeForm { if ($_[0] != 1) { print "Content-type: text/html\n\n"; } print $form; &debugDump(); } #======================================================================= # CookieaNftfH[flI?^?ipicoBBSae]pj #----------------------------------------------------------------------- # fNfbfL[a3 #----------------------------------------------------------------------- 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] = 1O # [1] = l # [2] = OA # [3] = fpfX # [4] = f[fh 0:HTTPfwfbf_ 0^EO: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 "\n"; } } #----------------------------------------------------------------------- # ftfH[flIfffR[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"; } 1;