User: racke
Date: 2009-04-27 10:00:17 GMT
Modified: . WHATSNEW-5.7
Modified: lib/Vend Dispatch.pm File.pm
Log:
Encoding and fallback for reading/writing files while in UTF-8 mode.
Revision Changes Path
2.40 interchange/WHATSNEW-5.7
rev 2.40, prev_rev 2.39
Index: WHATSNEW-5.7
===================================================================
RCS file: /var/lib/cvs/interchange/WHATSNEW-5.7,v
retrieving revision 2.39
retrieving revision 2.40
diff -u -r2.39 -r2.40
--- WHATSNEW-5.7 16 Apr 2009 16:58:31 -0000 2.39
+++ WHATSNEW-5.7 27 Apr 2009 10:00:17 -0000 2.40
@@ -103,6 +103,8 @@
would break sessions up into separate directories instead of putting all
sessions in a huge directory.
+* Encoding and fallback for reading/writing files while in UTF-8 mode.
+
Payment
-------
1.112 interchange/lib/Vend/Dispatch.pm
rev 1.112, prev_rev 1.111
Index: Dispatch.pm
===================================================================
RCS file: /var/lib/cvs/interchange/lib/Vend/Dispatch.pm,v
retrieving revision 1.111
retrieving revision 1.112
diff -u -r1.111 -r1.112
--- Dispatch.pm 6 Apr 2009 12:23:22 -0000 1.111
+++ Dispatch.pm 27 Apr 2009 10:00:17 -0000 1.112
@@ -1,6 +1,6 @@
# Vend::Dispatch - Handle Interchange page requests
#
-# $Id: Dispatch.pm,v 1.111 2009-04-06 12:23:22 markj Exp $
+# $Id: Dispatch.pm,v 1.112 2009-04-27 10:00:17 racke Exp $
#
# Copyright (C) 2002-2009 Interchange Development Group
# Copyright (C) 2002 Mike Heins <[email protected]>
@@ -26,7 +26,7 @@
package Vend::Dispatch;
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 1.111 $, 10);
+$VERSION = substr(q$Revision: 1.112 $, 10);
use POSIX qw(strftime);
use Vend::Util;
@@ -370,7 +370,10 @@
Content-Type: $CGI::values{mv_content_type}
Content-Length: $size
EOF
- ::response( Vend::Util::readfile ($CGI::values{mv_data_file}) );
+ ::response(
+ Vend::Util::readfile($CGI::values{mv_data_file}, undef, undef,
+ {encoding => 'raw'}));
+
return 0;
}
2.31 interchange/lib/Vend/File.pm
rev 2.31, prev_rev 2.30
Index: File.pm
===================================================================
RCS file: /var/lib/cvs/interchange/lib/Vend/File.pm,v
retrieving revision 2.30
retrieving revision 2.31
diff -u -r2.30 -r2.31
--- File.pm 22 Mar 2009 19:32:31 -0000 2.30
+++ File.pm 27 Apr 2009 10:00:17 -0000 2.31
@@ -1,6 +1,6 @@
# Vend::File - Interchange file functions
#
-# $Id: File.pm,v 2.30 2009-03-22 19:32:31 mheins Exp $
+# $Id: File.pm,v 2.31 2009-04-27 10:00:17 racke Exp $
#
# Copyright (C) 2002-2008 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -61,13 +61,18 @@
use File::Copy;
use subs qw(logError logGlobal);
use vars qw($VERSION @EXPORT @EXPORT_OK $errstr);
-$VERSION = substr(q$Revision: 2.30 $, 10);
+$VERSION = substr(q$Revision: 2.31 $, 10);
sub writefile {
my($file, $data, $opt) = @_;
+ my($encoding, $fallback);
- my $is_utf8;
- $is_utf8 = is_utf8(ref $data ? $$data : $data) if $::Variable->{MV_UTF8};
+ if ($::Variable->{MV_UTF8}) {
+ $encoding = $opt->{encoding} ||= 'utf-8';
+ undef $encoding if $encoding eq 'raw';
+ $fallback = $opt->{fallback};
+ $fallback = Encode::PERLQQ unless defined $fallback;
+ }
$file = ">>$file" unless $file =~ /^[|>]/;
if (ref $opt and $opt->{umask}) {
@@ -91,7 +96,11 @@
}
# We have checked for beginning > or | previously
open(MVLOGDATA, $file) or die "open\n";
- binmode(MVLOGDATA, ":utf8") if $is_utf8;
+ if ($encoding) {
+ local $PerlIO::encoding::fallback = $fallback;
+ binmode(MVLOGDATA, ":encoding($encoding)");
+ }
+
lockfile(\*MVLOGDATA, 1, 1) or die "lock\n";
seek(MVLOGDATA, 0, 2) or die "seek\n";
if(ref $data) {
@@ -105,7 +114,10 @@
else {
my (@args) = grep /\S/, Text::ParseWords::shellwords($file);
open(MVLOGDATA, "|-") || exec @args;
- binmode(MVLOGDATA, ":utf8") if $is_utf8;
+ if ($encoding) {
+ local $PerlIO::encoding::fallback = $fallback;
+ binmode(MVLOGDATA, ":encoding($encoding)");
+ }
if(ref $data) {
print(MVLOGDATA $$data) or die "pipe to\n";
}
@@ -181,10 +193,19 @@
# the file from the database.
sub readfile {
- my($ifile, $no, $loc) = @_;
- my($contents);
+ my($ifile, $no, $loc, $opt) = @_;
+ my($contents,$encoding,$fallback);
local($/);
+ $opt ||= {};
+
+ if ($::Variable->{MV_UTF8}) {
+ $encoding = $opt->{encoding} ||= 'utf-8';
+ $fallback = $opt->{fallback};
+ $fallback = Encode::PERLQQ unless defined $fallback;
+ undef $encoding if $encoding eq 'raw';
+ }
+
unless(allowed_file($ifile)) {
log_file_violation($ifile);
return undef;
@@ -204,6 +225,7 @@
}
if(! $file) {
+
$contents = readfile_db($ifile);
return undef unless defined $contents;
}
@@ -212,7 +234,12 @@
$Global::Variable->{MV_FILE} = $file;
binmode(READIN) if $Global::Windows;
- binmode(READIN, ":utf8") if $::Variable->{MV_UTF8};
+
+ if ($encoding) {
+ local $PerlIO::encoding::fallback = Encode::PERLQQ;
+ binmode(READIN, ":encoding($encoding)");
+ }
+
undef $/;
$contents = <READIN>;
close(READIN);
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.