Changeset e68fca

Timestamp:

01/13/08 14:34:25 (4 years ago)

Author:

Tomash Brechko <tomash.brechko@…>

Branches:

master, ketama-compat

Children:

dad4cc

Parents:

ccd211

git-author:

Tomash Brechko <tomash.brechko@…> (01/13/08 14:34:25)

git-committer:

Tomash Brechko <tomash.brechko@…> (01/13/08 14:34:25)

Message:

Add utf8 constructor parameter.

Files:

• Changes (modified) (1 diff)
• MANIFEST (modified) (1 diff)
• TODO (modified) (1 diff)
• lib/Cache/Memcached/Fast.pm (modified) (9 diffs)
• t/Memd.pm (modified) (1 diff)
• t/utf8.t (added)

Changes

@@ -31 +31 @@
         script/compare.pl was removed.  Instead script/benchmark.pl
         takes an optional last argument "compare".
+
+        New 'utf8' parameter for constructor.
 
 

MANIFEST

@@ -18 +18 @@
 t/pod-coverage.t
 t/pod.t
+t/utf8.t
 lib/Cache/Memcached/Fast.pm
 src/Makefile.PL

TODO

@@ -22 +22 @@
 
 - Add test for noreply, do not list it in MANIFEST.
-
-- utf8 => 1 (in utf8 branch).
 
 - tainted_in, tainted_out parameters.

lib/Cache/Memcached/Fast.pm

@@ -41 +41 @@
       ketama_points => 150,
       nowait => 1,
+      utf8 => ($^V >= 5.008001 ? 1 : 0),
   });
 
@@ -130 +131 @@
 use constant F_STORABLE => 0x1;
 use constant F_COMPRESS => 0x2;
+use constant F_UTF8     => 0x4;
 
 
@@ -166 +168 @@
 use fields qw(
     _xs servers
-    compress_threshold compress_ratio compress_methods
+    compress_threshold compress_ratio compress_methods utf8
 );
 
@@ -392 +394 @@
 
 
+=item I<utf8> (B<experimental, Perl 5.8.1 and later only>)
+
+  utf8 => 1
+  (default: disabled)
+
+The value is a boolean which enables (true) or disables (false) the
+conversion of Perl character strings to octet sequences in UTF-8
+encoding on store, and the reverse conversion on fetch (when the
+retrieved data is marked as being UTF-8 octet sequence).  See
+L<perlunicode|perlunicode>.
+
+
 =back
 
@@ -415 +429 @@
     }
 
+    if ($conf->{utf8}) {
+        if ($^V >= 5.008001) {
+            $self->{utf8} = 1;
+        } else {
+            carp "'utf8' may be enabled only for Perl >= 5.8.1, disabled";
+        }
+    }
+
     $self->{_xs} = new Cache::Memcached::Fast::_xs($conf);
 
@@ -473 +495 @@
         $flags |= F_STORABLE;
     } else {
-        $val_ref = \$_[0];
+        if ($self->{utf8} and utf8::is_utf8($_[0])) {
+            # We have to copy the value because we will modify it in place.
+            my $octets = $_[0];
+            utf8::encode($octets);
+            $flags |= F_UTF8;
+            $val_ref = \$octets;
+        } else {
+            $val_ref = \$_[0];
+        }
     }
 
@@ -519 +549 @@
         };
         return if $@;
+    } elsif ($_[1] & F_UTF8 and $self->{utf8}) {
+        return unless utf8::decode(${$_[0]});
     }
 
@@ -1489 +1521 @@
 
 
-=head1 UTF-8 and tainted data
-
-Current implementation does not preserve UTF-8 flag on scalars.
-Storing UTF-8 string and retrieving it back would return the same byte
-sequence, but UTF-8 flag will be forgotten.  See L<utf8|utf8>.
-
-Likewise, tainted flag is neither tested nor preserved, storing
-tainted data and retrieving it back would clear tainted flag.  See
-L<perlsec|perlsec>.
+=head1 Tainted data
+
+In current implementation tainted flag is neither tested nor
+preserved, storing tainted data and retrieving it back would clear
+tainted flag.  See L<perlsec|perlsec>.
 
 
@@ -1565 +1593 @@
 Development of this module is sponsored by S<Monashev Co. Ltd.>
 
+Thanks to Peter J. Holzer for enlightening on UTF-8 support.
+
 
 =head1 WARRANTY

t/Memd.pm

@@ -29 +29 @@
         ketama_points => 150,
         nowait => 1,
+        utf8 => ($^V >= 5.008001 ? 1 : 0),
     );