Platon Technologies
neprihlásený Prihlásiť Registrácia
SlovakEnglish
open source software development oslavujeme 10 rokov vývoja otvoreného softvéru! Sobota, 14. jún 2025

Súbor: [Platon] / perl-modules / Platon / MySQL / Cache.pm (stiahnutie)

Revízia 1.1, Tue Mar 15 23:22:34 2005 UTC (20 years, 3 months ago) by rajo

Cache long queries (e.g. statistics from previous month) and store them on the filesystem.

#
# Platon::MySQL::Cache.pm
#
# Developed by Lubomir Host 'rajo' <rajo AT platon.sk>
# Copyright (c) 2005 Platon SDG, http://platon.sk/
# Licensed under terms of GNU General Public License.
# All rights reserved.
#
# Changelog:
# 2005-03-14 - created
#

# $Platon$

package Platon::MySQL::Cache;

use strict;
use Carp;
use Env;
use DBI qw(:sql_types);
use English;
use Digest::MD5 qw(md5_hex);
use Time::HiRes qw(gettimeofday);
use Compress::Zlib;
use Data::Dumper;

use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DEBUG);

@ISA        = qw(Exporter);
@EXPORT        = qw( );
$VERSION    = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG        = 0;

sub new
{ #{{{
    my $this  = shift;
    my $class = ref($this) || $this;
    my $config = shift;
    my $self  = {};
    my $default = {
        dbh            => undef,
        cache_dir    => "/var/tmp/mysql-query-cache-$EUID",
        enable_gzip    => 0,
        gzip_ext    => '.gz',
    };

    foreach my $key (keys %$default) {
        $self->{$key} = defined($config->{$key}) ? $config->{$key} : $default->{$key};
    }

    die "Cache directory '$self->{cache_dir}' not found." unless (-d $self->{cache_dir});
    
    bless $self, $class;

    return $self;
} # }}}

sub get_data($$)
{ #{{{
    my ($self, $param, $query, $query_param) = @_;
    my $data;
    my $dbh = $self->{dbh};

    my $full_info = Data::Dumper->Dump({
            param        => $param,
            query        => $query,
            query_param    => $query_param,
            data        => $data,
        });

    warn "FULL_INFO = '$full_info'";

    # generate unique query ID
    my $md5 = md5_hex($full_info);

    my $filename;
    if ($self->{enable_gzip}) {
        $filename = $md5 . $self->{gzip_ext};
    }
    else {
        $filename = $md5;
    }

    unless (-r $filename) {
        # data not cached, execute query and store into cache

        my $sth = $dbh->prepare($query);
        $sth->execute(@{$query_param}) or carp "Can't get data: " . $dbh->errstr();

        $data = $sth->fetchall_arrayref({});
        $sth->finish();

        if ($self->{enable_gzip}) {
            my $gz;
            $gz = gzopen($self->{file}, "wb")
                or carp "Can't write to cache: " . $gz->gzerror();
            $gz->gzwrite($full_info)
                or carp "Error writing to cache: " . $gz->gzerror();
            $gz->gzclose;
        }
        else {
            open(CACHE, ">$filename") or carp "Can't rite to cache: $!";
            print CACHE $full_info;
            close(CACHE);
        }

    }
    else {
        $data = $self->_read_cache($param, $query);
    }
    

} # }}}


1;

__END__

=head1 NAME

Cache - <<<description of module>>>

=head1 SYNOPSIS

  use Cache;

  my $xxx = new Cache;

=head1 DESCRIPTION

The Cache module allows you ...
<<<your description here>>>

=head2 EXPORT

<<here describe exported methods>>>

=head1 SEE ALSO

=head1 AUTHORS

Lubomir Host 'rajo', <rajo AT platon.sk>

=cut

# vim: ts=4
# vim600: fdm=marker fdl=0 fdc=3


Platon Group <platon@platon.sk> http://platon.sk/
Copyright © 2002-2006 Platon Group
Stránka používa redakčný systém Metafox
Na začiatok