/[Apache_czs]/czs.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /czs.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Tue Jan 16 08:35:53 2001 UTC (20 years, 8 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +4 -4 lines
/czs/ works on Macs too, register only on files with .htm* extension
(so that cgi-bin scripts work)

1 package Apache::czs;
2
3 use strict;
4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
5
6 $VERSION = '0.03';
7
8 use Apache::Constants qw(:common :response);
9
10 my $DEBUG = 1;
11
12 sub handler {
13 my $r = shift;
14
15 my $Status = NOT_FOUND;
16 my $charset;
17
18 my $fn=$r->filename;
19
20 my $fh = $r->gensym;
21 $r->register_cleanup(sub {close $fh});
22
23 return DECLINED if # don't scan the file if..
24 !$r->is_main # a subrequest
25 || $r->content_type ne "text/html"; # it isn't HTML
26 return NOT_FOUND unless open($fh, $fn); # we can't open it
27
28 # local($/) = "\n";
29 local $/;
30
31 my $content = <$fh>;
32
33 my $ua = $r->header_in('User-Agent');
34
35 $charset = "iso-8859-2";
36
37 $content =~ s,text/html; charset=iso-8859-2,text/html,gi;
38
39 if ($ENV{DO_CZS}) {
40 $content =~ tr,¹ðè澩ÐÈÆ®,sdcczSDCCZ,;
41 $charset = "iso-8859-1";
42 }
43
44 if ($ENV{DO_XMAC}) {
45 $charset = "x-mac-roman";
46 } elsif ($ENV{DO_MACCE}) {
47 $charset = "MacCE";
48 } elsif (!$ENV{DO_CZS} && $ua =~ m,Mac,i && $r->method eq 'GET') {
49 my $uri;
50 if ($ua =~ m,MSIE,i) {
51 $uri="/xmac";
52 } else {
53 $uri="/macce";
54 }
55 $uri .= $r->uri;
56 $uri .= "?".$r->args if ($r->args);
57 $r->warn("go to mac $uri") if ($DEBUG);
58 $r->uri($uri);
59 $r->content_type("text/html");
60 $r->header_out(Location => $uri);
61 $r->header_out(URI => $uri);
62 $r->status(REDIRECT);
63 return REDIRECT;
64 }
65
66
67 if ($charset) {
68 $r->content_type("text/html; charset=$charset");
69 }
70
71 $r->warn("$ua $charset") if ($DEBUG);
72
73 $r->send_http_header;
74
75 $content.="\n<!-- ".$r->header_in('User-Agent')." -- $charset -->\n" if ($DEBUG);
76
77
78 $r->print($content);
79
80 return OK;
81
82 }
83
84 sub trans {
85 my $r = shift;
86
87 my $uri = $r->uri;
88 my $ua = $r->header_in('User-Agent');
89
90 if ($uri =~ s/\/czs\//\//i) {
91 $r->subprocess_env('DO_CZS' => 1);
92 } elsif ($uri =~ s/\/xmac\//\//i) {
93 $r->subprocess_env('DO_XMAC' => 1);
94 } elsif ($uri =~ s/\/macce\//\//i) {
95 $r->subprocess_env('DO_MACCE' => 1);
96 }
97
98 $r->uri($uri);
99 return DECLINED;
100 }
101
102 1;
103 __END__
104
105 =head1 NAME
106
107 Apache::czs - does magic with Croatian characters
108
109 =head1 SYNOPSIS
110
111 PerlTransHandler Apache::czs::trans
112 <Files ~ "\.htm" >
113 SetHandler perl-script
114 PerlModule Apache::czs
115 PerlHandler Apache::czs::handler
116 </Files>
117
118 =head1 DESCRIPTION
119
120 Modifies pages based on URL and/or User-Agent.
121
122 - redirects Machintosh users to virutal URLs /macce/ and /xmac/ based
123 on thair User-Agent (Netscape, IE) and charset (to be friendly to
124 cache engines)
125
126 - supports virtual URL /czs/ for removing Croatian characters (and
127 setting character set to iso-8859-1)
128
129 - removes META charset from html document
130
131
132 =head1 AUTHOR
133
134 Dobrica Pavlinusic <dpavlin@rot13.org>
135
136 =head1 SEE ALSO
137
138 perl(1), apache(1).
139
140 =cut

  ViewVC Help
Powered by ViewVC 1.1.26