view release on metacpan or  search on metacpan

lib/Net/Clacks/ClacksCache.pm  view on Meta::CPAN

    my $clacks;
    if(defined($self->{host}) && defined($self->{port})) {
        $clacks = Net::Clacks::Client->new($self->{host}, $self->{port}, 
                                            $self->{user}, $self->{password}, 
                                            $self->{APPNAME} . '/' . $VERSION, 0)
                or croak("Can't connect to Clacks server");
    } elsif(defined($self->{socketpath})) {
        $clacks = Net::Clacks::Client->newSocket($self->{socketpath}, 
                                            $self->{user}, $self->{password}, 
                                            $self->{APPNAME} . '/' . $VERSION, 0)
                or croak("Can't connect to Clacks server");
    } else {
        croak("No valid connection configured. Don't know where to connect to!");
    }
    $self->{clacks} = $clacks;

    $self->{clacks}->disablePing(); # Webclient doesn't know when it is called again

    $self->set("VERSION::" . $self->{APPNAME}, $VERSION);

    $self->{clacks}->activate_memcached_compat;
    $self->{clacks}->disablePing();

    $self->extraInits(); # Hook for application specific inits

    return;
}

sub extraInits($self) {
    # Hook for application specific inits
    return;
}

sub extraDestroys($self) {
    # Hook for application specific destroys
    return;
}

sub fastdisconnect($self) {
    return if(!defined($self->{clacks}));    # never connected, nothing to do
    eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
        $self->{clacks}->fastdisconnect();
    };

    return;
}

sub disconnect($self) {
    return if(!defined($self->{clacks}));    # never connected, nothing to do
    eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
        $self->{clacks}->disconnect();
    };

    return;
}

sub DESTROY($self) {
    # During Perl's global destruction phase, package symbol tables are torn
    # down in arbitrary order. By the time DESTROY runs here the inner
    # Net::Clacks::Client (and IO::Socket::SSL, IO::Select, etc.) may already
    # be unavailable. Skip cleanup entirely in that phase — the kernel closes
    # any leftover FD on process exit and the server detects EOF.
    return if(${^GLOBAL_PHASE} eq 'DESTRUCT');

    # Outside global destruction, do a *fast* close (no flush, no QUIT, no
    # sleeps). DESTROY can run at moments where the graceful path is
    # inappropriate (worker child unwinding after fork, exception
    # propagation, local-block exit). Callers who want a graceful protocol-
    # level close should call $cache->disconnect() explicitly first.
    if(defined($self->{clacks})) {
        eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
            $self->{clacks}->fastdisconnect();
        };
    }

    # Wrap extraDestroys too — a subclass override might throw during
    # teardown, and we don't want that to escape DESTROY (Perl turns
    # propagated exceptions out of DESTROY into "(in cleanup)" warnings).
    eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
        $self->extraDestroys();
    };

    return;
}

sub get($self, $key) {
    $self->reconnect(); # Make sure we are connected

    $key = $self->sanitize_key($key);

    my $value = $self->{clacks}->retrieve($key);
    return if(!defined($value));

    if($value =~ /^PAGECAMELCLACKSYAMLB64\:(.+)/o) {
        $value = decode_base64($1);
        $value = Load($value);
        $value = $self->deref($value);
    } elsif($value =~ /^PAGECAMELCLACKSB64\:(.+)/o) {
        $value = decode_base64($1);
    }
    return $value;
}

sub set($self, $key, $data) { ## no critic (NamingConventions::ProhibitAmbiguousNames)
    $self->reconnect(); # Make sure we are connected

    $key = $self->sanitize_key($key);

    if(ref $data ne '') {
        #$data = 'PAGECAMELCLACKSYAMLB64: ' . encode_base64(Dump($data), '');
        $data = Dump($data);
        $data = 'PAGECAMELCLACKSYAMLB64: ' . encode_base64($data, '');
    } elsif($data =~ /^PAGECAMELCLACKSB64/o) {
        # Already encoded? Clacks injection alert? Just don't store the thing...
        return false;
    } elsif($data =~ /\n/o || $data =~ /\r/o) {
        $data = 'PAGECAMELCLACKSB64:' . encode_base64($data, '');
    }

    $self->{clacks}->store($key, $data);