- 

#!/usr/bin/perl

# koha-memcached -- interact with items stored in memcached

# Copyright 2020  Libriotech AS

#

# This program is free software: you can redistribute it and/or modify

# it under the terms of the GNU General Public License as published by

# the Free Software Foundation, either version 3 of the License, or

# (at your option) any later version.

#

# This program is distributed in the hope that it will be useful,

# but WITHOUT ANY WARRANTY; without even the implied warranty of

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

# GNU General Public License for more details.

#

# You should have received a copy of the GNU General Public License

# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use Memcached::libmemcached qw( memcached_create memcached_server_add memcached_get memcached_delete );

use Data::Dumper;

use Getopt::Long;

use Modern::Perl;

Getopt::Long::Configure("bundling");

my %opts;

my $res = GetOptions( \%opts,

    "list|l=s", 

    "get|g=s",

    "delete|d=s",

    "help|h",

);

if ( !$res || $opts{help} ) {

    show_help( !$res );

    exit( !$res );

}

if ( !@ARGV ) {

    show_help( 1, "An instance name must be supplied." );

    exit(1);

}

my $instance = shift @ARGV;

if ( !-e "/etc/koha/sites/$instance" ) {

    show_help( 1, "The instance doesn't exist: $instance" );

    exit(1);

}

my $memc = memcached_create();

memcached_server_add( $memc, "localhost", '11211' ); # FIXME Get this from koha-conf.xml

if ( defined $opts{list} ) {

    if ( $opts{list} eq 'all' ) {

        say sort `memcdump --servers=localhost | grep "koha_$instance"`;

    } elsif ( $opts{list} eq 'authval' ) {

        say sort `memcdump --servers=localhost | grep "koha_$instance" | grep "::AuthorisedValues"`;

    } elsif ( $opts{list} eq 'syspref' ) {

        say sort `memcdump --servers=localhost | grep "koha_$instance" | grep "syspref:syspref"`;

    }

} elsif ( defined $opts{get} ) {

    $opts{get} = expand_shortcut( $opts{get}, $instance );

    say memcached_get( $memc, $opts{get} );

} elsif ( defined $opts{delete} ) {

    $opts{delete} = expand_shortcut( $opts{delete}, $instance );

    memcached_delete( $memc, $opts{delete} );

}

sub expand_shortcut {

    my ( $string, $instance ) = @_;

    my %shortcut = (

        'config' => "koha_$instance:config:koha_conf",

    );

    if ( defined $shortcut{ $string } ) {

        return $shortcut{ $string };

    } else {

        return $string;

    }

}

sub show_help {

    my ( $err, $msg ) = @_;

    my $fh = $err ? *STDERR : *STDOUT;

    say $fh "Error: " . $msg if $msg;

    print $fh $_ while <DATA>;

}

__DATA__

koha-memcached -- interact with items stored in memcached

Usage: koha-memcached [options] [instance name]

Options:

    -l, --list TYPE     list all KEYS of type TYPE (all, syspref, authval)

    -g, --get KEY       display the value associated with a KEY

    -d, --delete KEY    delete the value for a given KEY

    -h, --help          show this help and quit

Possible values for TYPE:

    all     = display all KEYS

    syspref = display KEYS for all systempreferences

    authval = display KEYS for all authorised values

    other   = all keys that are not in the specific categories above (not implemented)

Special values/shortcuts for KEY:

    config = the configuration from koha-conf.xml