Permalink
Browse files

initial import

git-svn-id: https://perl-cache.googlecode.com/svn/chi/trunk@210 fe4db14e-1138-0410-ae3a-bd28db37d31a
  • Loading branch information...
0 parents commit 21af024c9be68a0e05026f0a4367bdcfbd7e7cc0 swartz@pobox.com committed Nov 9, 2007
@@ -0,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+CHI-*
+cover_db
@@ -0,0 +1,5 @@
+Revision history for CHI
+
+0.01 Date/time
+ First version, released on an unsuspecting world.
+
@@ -0,0 +1,9 @@
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+Makefile.PL
+README
+lib/CHI.pm
+t/00-load.t
+t/pod-coverage.t
+t/pod.t
@@ -0,0 +1,20 @@
+use inc::Module::Install;
+
+name 'CHI';
+all_from 'lib/CHI.pm';
+
+build_requires 'Test::More';
+
+requires 'File::Spec' => 0;
+requires 'List::MoreUtils' => '0.21';
+requires 'Storable' => 0;
+requires 'Sys::HostIP' => '1.3.1';
+requires 'Time::Duration::Parse' => '0.03';
+requires 'URI::Escape' => '3.28';
+
+license 'perl';
+
+auto_install;
+
+WriteAll;
+
52 README
@@ -0,0 +1,52 @@
+CHI
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it to get an idea of the module's uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc CHI
+
+You can also look for information at:
+
+ RT, CPAN's request tracker
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=CHI
+
+ AnnoCPAN, Annotated CPAN documentation
+ http://annocpan.org/dist/CHI
+
+ CPAN Ratings
+ http://cpanratings.perl.org/d/CHI
+
+ Search CPAN
+ http://search.cpan.org/dist/CHI
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Jonathan Swartz
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
30 TODO
@@ -0,0 +1,30 @@
+TO DO
+
+* put in module form
+* Run Rob Mueller's cacheperl.pl against CHI drivers
+* perl critic
+* expires_window
+* expires_next => ['hour', 'day']
+* Drivers
+ * BerkeleyDB (w/separate file per namespace, must handle locking)
+ * FastMMap
+ * memcached
+ * DBI or at least mysql
+* Test:
+ * set errors
+ * bad driver
+ * default settings for $cache object: expires_at, expires_in
+ * multiple writes same key
+ * simultaneous writes two procs, read by third proc
+. get and get_object should be generated subroutines, not runtime dispatched
+* Moosify, assuming no major effect on performance
+
+QUESTIONS
+
+* What should set() return? The value? Success flag? Cache::Cache doesn't seem to care.
+* Should we auto-remove items after a miss, like Cache::Cache? Or is this silly b/c it will probably be followed with a set?
+* Should namespace default to caller package?
+* What happens if a reference is passed as a key? Stringify reference, or reject, or serialize automatically to a key?
+* Should driver param accept a full class in addition to a classname assumed to be under CHI::Driver?
+* Should get_namespace() always report empty namespaces - i.e. namespaces that have been created but not populated, or namespaces that have been cleared?
+* ExtUtils::MakeMaker, Module::Build or Module::Install?
@@ -0,0 +1 @@
+caches
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+use Benchmark qw(:all);
+use Digest::JHash;
+use Digest::MD5 qw(md5_hex);
+use String::Random qw(random_string);
+use warnings;
+use strict;
+
+my @keys = map { random_string(scalar("c" x ($_ * 10))) } (1..20);
+
+sub md5
+{
+ foreach my $key (@keys) {
+ my $hash = substr(md5_hex($key), 0, 3);
+ }
+}
+
+sub jhash
+{
+ foreach my $key (@keys) {
+ my $hash = substr(sprintf("%x", Digest::JHash::jhash($key)), 0, 3);
+ }
+}
+
+timethese(10000, {
+ 'MD5' => \&md5,
+ 'JHash' => \&jhash,
+ });
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+use FindBin::libs;
+use Benchmark qw(:all);
+use Cache::FileCache;
+use CHI;
+use Cwd qw(realpath);
+use Data::Dump qw(dump);
+use File::Basename;
+use File::Path qw(rmtree);
+use File::Temp qw(tempdir);
+use Getopt::Long;
+use String::Random qw(random_string);
+use warnings;
+use strict;
+
+my $cwd = dirname(realpath($0));
+
+my $only_chi = '';
+my $test_writes = 0;
+GetOptions(
+ 'only-chi' => \$only_chi,
+ 'test-writes' => \$test_writes,
+ );
+
+my @keys = map { random_string(scalar("c" x ($_ * 2))) } (1..100);
+
+sub temp_dir
+{
+ return tempdir('name-XXXX', TMPDIR => 1, CLEANUP => 1);
+}
+
+sub test_cache
+{
+ my ($cache) = @_;
+
+ if ($test_writes) {
+ foreach my $key (@keys) {
+ $cache->set($key, $key);
+ }
+ }
+ else {
+ foreach my $key (@keys) {
+ $cache->get($key);
+ }
+ }
+}
+
+rmtree("$cwd/caches");
+my $chi_cache = CHI->new({driver => 'File', root_dir => "$cwd/caches/chi_cache"});
+my $cache_cache;
+$cache_cache = Cache::FileCache->new({cache_root => "$cwd/caches/cache_cache"}) unless $only_chi;
+unless ($test_writes) {
+ foreach my $key (@keys) {
+ $chi_cache->set($key, $key);
+ }
+ unless ($only_chi) {
+ foreach my $key (@keys) {
+ $cache_cache->set($key, $key);
+ }
+ }
+}
+
+sub bench
+{
+ my $iter = $test_writes ? 40 : 100;
+ timethese($iter, {
+ 'CHI::Driver::File' => sub { test_cache($chi_cache) },
+ ($only_chi ? () : ('Cache::FileCache' => sub { test_cache($cache_cache) })),
+ });
+}
+
+bench();
@@ -0,0 +1,5 @@
+#!/bin/bash
+perl -d:DProf file_cache.pl --only-chi
+# perl -d:DProf file_cache.pl --only-chi --test-writes
+dprofpp -E -O50 > dprofppe.out
+dprofpp -I -O50 > dprofppi.out
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use Benchmark qw(:all);
+use Carp;
+use File::Slurp;
+use File::Temp qw(tempfile);
+use POSIX qw( :fcntl_h ) ;
+use Fcntl qw( :DEFAULT ) ;
+use warnings;
+use strict;
+
+my $content = "a" x 100000;
+my ($fh, $file) = tempfile(UNLINK => 1);
+write_file($file, $content);
+
+sub read_binary_file {
+ my $buf = "";
+ my $read_fh;
+ unless ( sysopen( $read_fh, $file, O_RDONLY | O_BINARY ) ) {
+ croak "read_file '$file' - sysopen: $!";
+ }
+ my $size_left = -s $read_fh ;
+
+ while( 1 ) {
+ my $read_cnt = sysread( $read_fh, $buf, $size_left, length $buf );
+
+ if ( defined $read_cnt ) {
+ last if $read_cnt == 0 ;
+ $size_left -= $read_cnt ;
+ last if $size_left <= 0 ;
+ }
+ else {
+ croak "read_file '$file' - sysread: $!";
+ }
+ }
+}
+
+timethese(5000, {
+ 'read_slurp' => sub { my $c = read_file($file, bin_mode => ':raw') },
+ 'read_open' => sub { open(my $fh, $file); binmode($fh); local $/; my $c = <$fh> },
+ 'read_binary_file' => \&read_binary_file,
+# 'write_slurp' => sub { write_file($file, { bin_mode => ':raw' }, $content) },
+# 'write_open' => sub { open(my $fh, ">$file"); binmode($fh); print $fh $content },
+ });
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use Benchmark qw(:all);
+use Data::UUID;
+use Sys::HostIP;
+use warnings;
+use strict;
+
+my $ug = Data::UUID->new();
+
+my $idnum = 0;
+my $netaddr = sprintf( '%02X%02X%02X%02X', split( /\./, Sys::HostIP->ip ) );
+
+my $plusctr = 0;
+my $uuid = $ug->create_hex;
+
+timethese(400000, {
+ 'uuid' => sub { my $hex = $ug->create_hex },
+ 'uuid_plus' => sub { if (!$plusctr) { $uuid = $ug->create_hex }; my $hex = sprintf('%s%04x', $uuid, $plusctr++); $plusctr &= 0xffff },
+ 'sys::uniqueid' => sub { my $hex = sprintf '%012X.%s.%08X.%08X', time, $netaddr, $$, ++$idnum },
+ });
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use Benchmark qw(:all);
+use Carp;
+use File::Slurp;
+use File::Temp qw(tempfile);
+use POSIX qw( :fcntl_h ) ;
+use Fcntl qw( :DEFAULT ) ;
+use warnings;
+use strict;
+
+my $content = "a" x 100000;
+my $file = "content.txt";
+
+sub write_binary_file {
+ my $buf = $content;
+ my $write_fh;
+ unless ( sysopen( $write_fh, $file, O_WRONLY | O_CREAT | O_BINARY ) ) {
+ croak "write_file '$file' - sysopen: $!";
+ }
+ my $length = length($buf);
+ my $size_left = $length;
+ my $offset = 0;
+
+ do {
+ my $write_cnt = syswrite( $write_fh, $buf,
+ $size_left, $offset ) ;
+
+ unless ( defined $write_cnt ) {
+ croak "write_file '$file' - syswrite: $!";
+ }
+ $size_left -= $write_cnt ;
+ $offset += $write_cnt ;
+
+ } while( $size_left > 0 ) ;
+
+ truncate( $write_fh, $length );
+}
+
+timethese(5000, {
+ 'write_binary_file' => \&write_binary_file,
+ 'write_slurp' => sub { write_file($file, { bin_mode => ':raw' }, $content) },
+ 'write_open' => sub { open(my $fh, ">$file"); binmode($fh); print $fh $content },
+ });
Oops, something went wrong.

0 comments on commit 21af024

Please sign in to comment.