[Koha-cvs] koha/C4/Interface/CGI Output.pm

[paul poulain]

CVSROOT:	/sources/koha
Module name:	koha
Changes by:	paul poulain <tipaul>	07/03/09 14:45:09

Modified files:
	C4/Interface/CGI: Output.pm 

Log message:
	rel_3_0 moved to HEAD

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Interface/CGI/Output.pm?cvsroot=koha&r1=1.7&r2=1.8

Patches:
Index: Output.pm
===================================================================
RCS file: /sources/koha/koha/C4/Interface/CGI/Output.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- Output.pm	6 Sep 2006 16:21:04 -0000	1.7
+++ Output.pm	9 Mar 2007 14:45:09 -0000	1.8
@@ -1,6 +1,6 @@
 package C4::Interface::CGI::Output;
 
-# $Id: Output.pm,v 1.7 2006/09/06 16:21:04 tgarip1957 Exp $
+# $Id: Output.pm,v 1.8 2007/03/09 14:45:09 tipaul Exp $
 
 #package to work around problems in HTTP headers
 # Note: This is just a utility module; it should not be instantiated.
@@ -22,9 +22,10 @@
 # You should have received a copy of the GNU General Public License along with
 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 # Suite 330, Boston, MA  02111-1307 USA
+
 use strict;
 require Exporter;
-use open ':utf8';
+
 use vars qw($VERSION @ISA @EXPORT);
 
 # set the version for version checking
@@ -36,9 +37,9 @@
 
 =head1 SYNOPSIS
 
-  use C4::Interface::CGI::Output;
+  use C4::CGI::Output;
 
-  print $query->header(-type => "text/html"), $output;
+  print $query->header(-type => C4::CGI::Output::gettype($output)), $output;
 
 =head1 DESCRIPTION
 
@@ -52,12 +53,46 @@
 =cut
 
 @ISA = qw(Exporter);
- at EXPORT = qw(	&output_html_with_http_headers
+ at EXPORT = qw(
+		&guesscharset
+		&guesstype
+		&output_html_with_http_headers
 		);
 
+=item guesscharset
+
+   &guesscharset($output)
+
+"Guesses" the charset from the some HTML that would be output.
 
+C<$output> is the HTML page to be output. If it contains a META tag
+with a Content-Type, the tag will be scanned for a language code.
+This code is returned if it is found; undef is returned otherwise.
 
+This function only does sloppy guessing; it will be confused by
+unexpected things like SGML comments. What it basically does is to
+grab something that looks like a META tag and scan it.
 
+=cut
+
+sub guesscharset ($) {
+    my($html) = @_;
+    my $charset = undef;
+    local($`, $&, $', $1, $2, $3);
+    # FIXME... These regular expressions will miss a lot of valid tags!
+    if ($html =~ /<meta\s+http-equiv=(["']?)Content-Type\1\s+content=(["'])text\/html\s*;\s*charset=([^\2\s\r\n]+)\2\s*(?:\/?)>/is) {
+        $charset = $3;
+    } elsif ($html =~ /<meta\s+content=(["'])text\/html\s*;\s*charset=([^\1\s\r\n]+)\1\s+http-equiv=(["']?)Content-Type\3\s*(?:\/?)>/is) {
+        $charset = $2;
+    }
+    return $charset;
+} # guess
+
+sub guesstype ($) {
+    my($html) = @_;
+    my $charset = guesscharset($html);
+    return defined $charset? "text/html; charset=$charset": "text/html";
+}
 
 =item output_html_with_http_headers
 
@@ -70,11 +105,9 @@
 =cut
 
 sub output_html_with_http_headers ($$$) {
-
     my($query, $cookie, $html) = @_;
     print $query->header(
-	-type   => "text/html",
-	-charset=>"UTF-8",
+	-type   => guesstype($html),
 	-cookie => $cookie,
   ), $html;
 }