Attachment #51705 for bug #10662

View | Details | Raw Unified | Return to bug 10662
Collapse All | Expand All

Lines 796-802 our $PERL_DEPS = { Link Here

(-)a/C4/Installer/PerlDependencies.pm (-1 / +6 lines)
796	'usage' => 'Test code coverage',	796	'usage' => 'Test code coverage',
797	'required' => '0',	797	'required' => '0',
798	'min_ver' => '0.11',	798	'min_ver' => '0.11',
799	}	799	},
		800	'POE' => {
		801	'usage' => 'Icarus job server',
		802	'required' => '1',
		803	'min_ver' => '1.35',
		804	},
800	};	805	};
801		806
802	1;	807	1;




package Koha::Icarus;

# Copyright 2016 Prosentient Systems
#
# This file is part of Koha.
#
# Koha 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.
#
# Koha 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 Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;
use IO::Socket::UNIX;
use IO::Select;
use URI;
use JSON;

sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;
    return bless ($args, $class);
}

sub connected {
    my ($self) = @_;
    if ($self->{_connected}){
        return 1;
    }
}

sub connect {
    my ($self) =  @_;
    my $socket_uri = $self->{socket_uri};
    if ($socket_uri){
        my $uri = URI->new($socket_uri);
        if ($uri && $uri->scheme eq 'unix'){
            my $socket_path = $uri->path;
            my $socket = IO::Socket::UNIX->new(
                Type => IO::Socket::UNIX::SOCK_STREAM(),
                Peer => $socket_path,
            );
            if ($socket){
                my $socketio = new IO::Select();
                $socketio->add($socket);
                #FIXME: Should probably fix these return values...
                $self->{_socketio} = $socketio;
                $self->{_socket} = $socket;
                my $message = $self->_read();
                if ($message eq 'HELLO'){
                    $self->{_connected} = 1;
                    return 1;
                }
            }
        }
    }
    return 0;
}

sub add_task {
    my ($self, $args) = @_;
    my $task = $args->{task};
    if ($task && %$task){
        my $response = $self->command("add task", undef, $task);
        if ($response){
            return $response;
        }
    }
}

sub start_task {
    my ($self, $args) = @_;
    my $task_id = $args->{task_id};
    if ($task_id){
        my $response = $self->command("start task", $task_id);
        if ($response){
            return $response;
        }
    }
}

sub remove_task {
    my ($self, $args) = @_;
    my $task_id = $args->{task_id};
    if ($task_id){
        my $response = $self->command("remove task", $task_id);
        if ($response){
            return $response;
        }
    }
}

sub list_tasks {
   my ($self) = @_;
   my $response = $self->command("list tasks");
    if ($response){
        if (my $tasks = $response->{tasks}){
            return $tasks;
        }
    }
}

sub shutdown {
    my ($self) = @_;
    my $response = $self->command("shutdown");
    if ($response){
        return $response;
    }
}





sub command {
    my ($self, $command, $task_id, $task) = @_;
    my $serialized = $self->_serialize({ "command" => $command, "task_id" => $task_id, "task" => $task });
    if ($serialized){
        $self->_write({ serialized => $serialized });
        my $json = $self->_read();
        if ($json){
            my $response = from_json($json);
            if ($response){
                return $response;
            }
        }
    }
}

sub _serialize {
    my ($self, $output) = @_;
    my $serialized = to_json($output);
    return $serialized;
}

sub _write {
    my ($self, $args) = @_;
    my $socket = $self->{_socket};
    my $output = $args->{serialized};
    if ($output){
        if (my $socketio = $self->{_socketio}){
            if (my @filehandles = $socketio->can_write(5)){
                foreach my $filehandle (@filehandles){
                    #Localize output record separator as null
                    local $\ = "\x00";
                    print $socket $output;
                }
            }
        }
    }
}

sub _read {
    my ($self) = @_;
    if (my $socketio = $self->{_socketio}){
        if (my @filehandles = $socketio->can_read(5)){
            foreach my $filehandle (@filehandles){
                #Localize input record separator as null
                local $/ = "\x00";
                my $message = <$filehandle>;
                chomp($message) if $message;
                return $message;
            }
        }
    }
}



1;




package Koha::Icarus::Base;

use Modern::Perl;
use DateTime;

use constant DEBUG => 9;
use constant SILENT => 0;

sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;
    return bless ($args, $class);
}

sub debug {
    my ($self,$message) = @_;
    if ($self->{Verbosity} == DEBUG){
        $self->log($message);
    }
}

sub log {
    my ($self,$message) = @_;
    my $id = $self->{_id};
    my $component = $self->{_component} // "component";
    if ( ($self->{Verbosity}) && ($self->{Verbosity} > SILENT) ){
        my $now = DateTime->now(time_zone => "local");
        say "[$now] [$component $id] $message";
    }
}

1;




package Koha::Icarus::Listener;

use Modern::Perl;
use parent 'Koha::Icarus::Base';

use POE qw(Wheel::ReadWrite Wheel::SocketFactory Wheel::Run);
use IO::Socket qw(AF_UNIX);
use URI;
use Koha::Icarus::Task;
use JSON; #For "on_client_input"

my $null_filter = POE::Filter::Line->new(
     Literal => chr(0),
);

sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;
    $args->{_component} = "server";
    $args->{_id} = "undefined";
    return bless ($args, $class);
}

#NOTE: "spawn" inspired by http://poe.perl.org/?POE_Cookbook/Object_Methods
sub spawn {
    my ($class, $args) = @_;
    my $self = $class->new($args);
    POE::Session->create(
        object_states => [
            $self => {
                _start => "on_server_start",
                shutdown => "shutdown",
                set_verbosity => "set_verbosity",
                _child => "on_task_event",
                got_list_tasks => "on_list_tasks",
                graceful_shutdown => "graceful_shutdown",
                got_client_accept => "on_client_accept",
                got_client_error => "on_client_error",
                got_server_error => "on_server_error",
                got_add_task => "on_add_task",
                got_client_input => "on_client_input",
            },
        ],
    );
}

#Methods for POE::Session

sub on_server_start {
    my ($self, $kernel,$heap,$session) = @_[OBJECT, KERNEL,HEAP,SESSION];
    my $server_id = $session->ID;
    $self->{_id} = $server_id; #Set internal id for logging purposes


    my $bind_address_uri = $self->{Socket};
    my $max_tasks = $self->{MaxTasks};

    $kernel->sig(INT => "graceful_shutdown");
    $kernel->sig(TERM => "graceful_shutdown");

    $heap->{max_tasks} = $max_tasks // 25; #Default maximum of 25 unless otherwise specified

    $self->log("Maximum number of tasks allowed: $heap->{max_tasks}");
    $self->log("Starting server...");

    my %server_params = (
        SuccessEvent => "got_client_accept",
        FailureEvent => "got_server_error",
    );

    #TODO: At this time, only "unix" sockets are supported. In future, perhaps TCP/IP sockets could also be supported.
    my $uri = URI->new($bind_address_uri);
    my $scheme = $uri->scheme;

    if ($scheme eq 'unix'){
        my $bind_address = $uri->path;
        $server_params{SocketDomain} = AF_UNIX;
        $server_params{BindAddress} = $bind_address;
        #When starting a unix socket server, you need to remove any existing references to that socket file.
        if ($bind_address && (-e $bind_address) ){
            $self->debug("Unlinking $bind_address");
            unlink $bind_address or warn "Could not unlink $bind_address: $!";
        }
    }

    $heap->{server} = POE::Wheel::SocketFactory->new(%server_params);

    if ($scheme eq 'unix'){
        #FIXME/DEBUGGING: This is a way to force a permission denied error...
        #chmod 0755, $uri->path;
        #Make the socket writeable to other users like Apache
        chmod 0666, $uri->path;
    }

}

sub shutdown {
    my ($self,$heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];

    if ($heap->{server}){
        $self->log("Shutting down server...");
        #Delete the server, so that you can't get any new connections
        delete $heap->{server} if $heap->{server};
    }

    if ($heap->{client}){
        $self->log("Shutting down any remaining clients...");
        #Delete the clients, so that you bring down the existing connections
        delete $heap->{client}; #http://www.perlmonks.org/?node_id=176971
    }
}

sub on_task_event {
    my ($self, $kernel, $heap,$session) = @_[OBJECT,KERNEL, HEAP,SESSION];
    my ($action,$child_session,$task) = @_[ARG0,ARG1,ARG2];

    my $child_id = $child_session->ID;

    $self->debug("$action child $child_id");


    if ($action eq 'create'){
        #NOTE: The $task variable is returned by the child POE session's _start event
        my $task_id = $child_session->ID;
        $heap->{tasks}->{$task_id}->{task} = $task;

    } elsif ($action eq 'lose'){
        my $task_id = $child_session->ID;
        delete $heap->{tasks}->{$task_id};
    }
}

#TODO: Put this in a parent class?
sub set_verbosity {
    my ($self,$session,$kernel,$new_verbosity) = @_[OBJECT,SESSION,KERNEL,ARG0];
    if (defined $new_verbosity){
        $self->{Verbosity} = $new_verbosity;
    }
}

sub on_list_tasks {
    my ($self, $kernel, $heap,$session) = @_[OBJECT, KERNEL, HEAP,SESSION];

    #DEBUG: You can access the POE::Kernel's sessions with "$POE::Kernel::poe_kernel->[POE::Kernel::KR_SESSIONS]".
    #While it's black magic you shouldn't touch, it can be helpful when debugging.

    my @tasks = ();
    foreach my $task_id (keys %{$heap->{tasks}} ){
        push(@tasks,{ task_id => $task_id, task => $heap->{tasks}->{$task_id}->{task} });
    }
    return \@tasks;
}

sub graceful_shutdown {
    my ($self, $heap,$session,$kernel,$signal) = @_[OBJECT, HEAP,SESSION,KERNEL,ARG0];

    #Tell the kernel that you're handling the signal sent to this session
    $kernel->sig_handled();
    $kernel->sig($signal);

    my $tasks = $kernel->call($session,"got_list_tasks");


    if ( $heap->{tasks} && %{$heap->{tasks}} ){
        $self->log("Waiting for tasks to finish...");
        foreach my $task_id (keys %{$heap->{tasks}}){
            $self->log("Task $task_id still exists...");
            $kernel->post($task_id,"got_task_stop");
        }
    } else {
        $self->log("All tasks have finished");
        $kernel->yield("shutdown");
        return;
    }

    $self->log("Attempting graceful shutdown in 1 second...");
    #NOTE: Basically, we just try another graceful shutdown on the next tick.
    $kernel->delay("graceful_shutdown" => 1);
}

#Accept client connection to listener
sub on_client_accept {
    my ($self, $client_socket, $server_wheel_id, $heap, $session) = @_[OBJECT, ARG0, ARG3, HEAP,SESSION];

    my $client_wheel = POE::Wheel::ReadWrite->new(
      Handle => $client_socket,
      InputEvent => "got_client_input",
      ErrorEvent => "got_client_error",
      InputFilter => $null_filter,
      OutputFilter => $null_filter,
    );

    $client_wheel->put("HELLO");
    $heap->{client}->{ $client_wheel->ID() } = $client_wheel;

    $self->debug("Connection ".$client_wheel->ID()." started.");

}

#Handle server error - shutdown server
sub on_server_error {
    my ($self, $operation, $errnum, $errstr, $heap, $session) = @_[OBJECT, ARG0, ARG1, ARG2,HEAP, SESSION];
    $self->log("Server $operation error $errnum: $errstr");
    delete $heap->{server};
}

#Handle client error - including disconnect
sub on_client_error {
    my ($self, $wheel_id,$heap,$session) = @_[OBJECT, ARG3,HEAP,SESSION];

    $self->debug("Connection $wheel_id failed or ended.");

    delete $heap->{client}->{$wheel_id};

}

sub on_add_task {
    my ($self, $message, $kernel, $heap, $session) = @_[OBJECT, ARG0, KERNEL, HEAP,SESSION];

    #Fetch a list of all tasks
    my @task_keys = keys %{$heap->{tasks}};

    #If the number in the list is less than the max, add a new task
    #else die.
    if (scalar @task_keys < $heap->{max_tasks}){
        my $server_id = $session->ID;
        my $task_session = Koha::Icarus::Task->spawn({ message => $message, server_id => $server_id, Verbosity => $self->{Verbosity}, });
        return $task_session->ID;
    } else {
        #This die should be caught by the event caller...
        die "Maximum number of tasks already reached.\n";
    }
}

sub on_client_input {
    my ($self, $input, $wheel_id, $session, $kernel, $heap) = @_[OBJECT, ARG0, ARG1, SESSION, KERNEL, HEAP];

    #Store server id more explicitly
    my $server_id = $session->ID;

    #Server listener has received input from client
    my $client = $heap->{client}->{$wheel_id};

    #Parse input from client
    my $message = from_json($input);

    if ( ref $message eq 'HASH' ){
        #Read "command" from client
        if (my $command = $message->{command}){
            $self->log("Message received with command \"$command\".");
            if ($command eq 'add task'){
                my $output = {};

                #Create a task session
                eval {
                   #NOTE: The server automatically keeps track of its child tasks
                    my $task_id = $kernel->call($server_id,"got_add_task",$message);

                    $output->{action} = "added";
                    $output->{task_id} = $task_id;
                };
                if ($@){
                    $self->debug("$@");
                    chomp($@);
                    $output->{action} = "error";
                    $output->{error_message} = $@;
                }
                my $server_output = to_json($output);
                $client->put($server_output);
                return;

            } elsif ( ($command eq 'remove task') || ($command eq 'start task' ) ){

                my $task_id = $message->{task_id};

                my $output = {
                    task_id => $task_id,
                };

                if ($command eq 'remove task'){
                    $kernel->call($task_id,"got_task_stop");
                    $output->{action} = "removed";
                } elsif ($command eq 'start task'){
                    my $response = $kernel->call($task_id, "on_task_init");
                    $output->{action} = $response;
                }

                if ($!){
                    $output->{action} = "error";
                    $output->{error_message} = $!;
                }

                #FIXME: What do we actually want to send back to the client?
                my $server_output = to_json($output);
                $client->put($server_output);
                return;

            } elsif ($command eq 'list tasks'){

                #Get tasks from listener (ie self)
                my $tasks = $kernel->call($server_id, "got_list_tasks");

                #Prepare output for client
                my $server_output = to_json({tasks => $tasks}, {pretty => 1});

                #Send output to client
                $client->put($server_output);
                return;

            } elsif ($command eq 'shutdown'){
                $kernel->post($server_id, "graceful_shutdown");
                my $server_output = to_json({action => 'shutting down'});
                $client->put($server_output);
                return;
            } else {
                $self->log("The message contained an invalid command!");
                $client->put("Sorry! That is an invalid command!");
                return;
            }
        } else {
            $self->log("The message was missing a command!");
        }
    } else {
        $self->log("The message was malformed!");
    }
    $client->put("Sorry! That is an invalid message!");
    return;
}

1;




package Koha::Icarus::Task;

use Modern::Perl;
use parent 'Koha::Icarus::Base';

use POE qw(Wheel::Run);
use DateTime;
use DateTime::Format::Strptime;
use JSON;
use Module::Load::Conditional qw/can_load/;

my $datetime_pattern = DateTime::Format::Strptime->new(
    pattern   => '%F %T',
    time_zone => 'local',
);
my $epoch_pattern = DateTime::Format::Strptime->new(
    pattern   => '%s',
);

sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;
    $args->{_component} = "task";
    $args->{_id} = "undefined";
    return bless ($args, $class);
}

#NOTE: "spawn" inspired by http://poe.perl.org/?POE_Cookbook/Object_Methods
sub spawn {
    my ($class, $args) = @_;
    my $self = $class->new($args);
    my $task_session = POE::Session->create(
        object_states => [
            $self => {
                _start => "on_task_create",
                 "got_child_stdout" => "on_child_stdout",
                 "got_child_stderr" => "on_child_stderr",
                 "got_child_close"  => "on_child_close",
                 "got_child_signal" => "on_child_signal",
                 "got_terminal_signal" => "on_terminal_signal",
                 "child_process_success" => "child_process_success",
                 "child_process_failure" => "child_process_failure",
                 "got_task_stop" => "on_task_stop",
                 "on_task_init" => "on_task_init",
                 "on_task_start" => "on_task_start",
            },
        ],
    );
    return $task_session;
}

sub on_task_create {
    my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];

    #Trap terminal signals so that the task can stop gracefully.
    $kernel->sig(INT => "got_terminal_signal");
    $kernel->sig(TERM => "got_terminal_signal");

    my $task_id = $session->ID;
    if ($task_id){
        #Tell the kernel that this task is waiting for an external action (ie keepalive counter)
        $kernel->refcount_increment($task_id,"waiting task");
        $self->{_id} = $task_id; #Set internal id for logging purposes
    }

    my $server_id = $self->{server_id};
    if ($server_id){
        $heap->{server_id} = $server_id;
    }

    my $task = undef;
    my $message = $self->{message};
    if ($message){
        $task = $message->{task};
        if ($task){
            $task->{status} = 'new';
            $heap->{task} = $task;
        }
    }
    return $task; #This return value is used by the parent POE session's _child handler
}

#This sub is just to start it now, or set it to start in the future... if the time is now or in the past, it starts now... if it's in the future, it starts in the future...
sub on_task_init {
    my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];
    my $response = 'pending';
    my $task = $heap->{task};
    my $status = $task->{status};
    if ($status){
        if ($status eq 'started'){
            $response = 'already started';
        } elsif ($status eq 'pending'){
            $response = 'already pending';
        } else {
            $task->{status} = 'pending';

            my $start = $task->{start};
            my $start_message = $start;


            my $dt;
            if ( $dt = $datetime_pattern->parse_datetime($start) ){
                #e.g. 2016-04-06 00:00:00
            } elsif ( $dt = $epoch_pattern->parse_datetime($start) ){
                #e.g. 1459837498 or apparently 0000-00-00 00:00:00
            } else {
                #If we don't match the datetime_pattern or epoch_pattern, then we start right now.
                $dt = DateTime->now( time_zone => 'local', );
            }
            if ($dt){
                $start = $dt->epoch;
                $start_message = $dt;
            }


            $self->log("Start task at $start_message");
            #NOTE: $start must be in UNIX epoch time (ie number of seconds that have elapsed since 00:00:00 UTC Thursday 1 January 1970)
            $kernel->alarm("on_task_start",$start);
        }
    }
    return $response;
}

sub on_task_start {
    my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];
    my $task = $heap->{task};
    $task->{status} = 'started';

    if (my $repeat_interval = $task->{repeat_interval}){
        #NOTE: Reset the start time with a human readable timestamp
        my $dt = DateTime->now( time_zone => 'local', );
        $dt->add( seconds => $repeat_interval );
        $task->{start} = $dt->strftime("%F %T");
    }
    #FIXME: You need to impose child process limits here! How many child processes are allowed to be running at any given time? Well, you can only have one child process per task...
    #so it's really more of a limit on the number of tasks... you probably need to have an internal task queue... that's easy enough though.
    my $child = POE::Wheel::Run->new(
        ProgramArgs => [ $task, ],
        Program => sub {
            my ($task) = @_;

            #Perform some last minute POE calls before running the task module plugin
            my $session = $poe_kernel->get_active_session();
            if ($session){
                my $heap = $session->get_heap();
                $poe_kernel->call($heap->{server_id},"set_verbosity",0); #This turns off the server logging in this forked process, so the following call() doesn't mess up our logs
                $poe_kernel->call($heap->{server_id},"shutdown"); #Shutdown the socket listener on the child process, so there's zero chance of writing to or reading from the socket in the child process
            }

            #NOTE: I don't know if this really needs to be run, but it shouldn't hurt.
            $poe_kernel->stop();

            #Try to load the task type module.
            my $task_type = $task->{type};
            if ( can_load ( modules => { $task_type => undef, }, ) ){
                #Create the object
                my $task_object = $task_type->new({task => $task, Verbosity => $self->{Verbosity}, });
                if ($task_object){
                    #Synchronous action: run the task module
                    $task_object->run;
                }
            } else {
                die "Couldn't load module $task_type: $Module::Load::Conditional::ERROR"
            }
        },
        StdoutEvent  => "got_child_stdout",
        StderrEvent  => "got_child_stderr",
        CloseEvent   => "got_child_close",
        NoSetPgrp => 1, #Keep child processes in same group as parent. This is especially useful when using Ctrl+C to kill the whole group.
    );

    $kernel->sig_child($child->PID, "got_child_signal");
    # Wheel events include the wheel's ID.
    $_[HEAP]{children_by_wid}{$child->ID} = $child;
    # Signal events include the process ID.
    $_[HEAP]{children_by_pid}{$child->PID} = $child;

    $self->debug("child pid ".$child->PID." started as wheel ".$child->ID);
}

sub on_task_stop {
    my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];
    my $task = $heap->{task};
    $task->{status} = 'stopping';
    my $task_id = $session->ID;
    my $server_id = $heap->{server_id};

    if ($heap->{stopping}){
        $self->debug("Task is already in the process of stopping...");

    } else {

        $self->log("Trying to stop task.");


        #Mark this task as stopping
        $heap->{stopping} = 1;

        #Stop the task from spawning new jobs
        $kernel->alarm("on_task_start");

        my $children_by_pid = $heap->{children_by_pid};
        if ($children_by_pid && %$children_by_pid){

            $self->debug("Child processes in progres...");
            my $child_processes = $heap->{children_by_pid};
            foreach my $child_pid (keys %$child_processes){
                my $child = $child_processes->{$child_pid};
                $self->debug("Telling child pid $child_pid to stop");
                $child->put("quit");
                #TODO: Perhaps it would be worthwhile having a kill switch too?
                # my $rv = $child->kill("TERM");
            }
        }

        $self->log("Removing task keepalive.");

        $kernel->refcount_decrement($task_id,"waiting task");
    }
}

sub on_terminal_signal {
    my ($self, $signal,$session,$kernel) = @_[OBJECT, ARG0,SESSION,KERNEL];
    $self->debug("Trapped SIGNAL: $signal.");
    #Gracefully stop the task
    $kernel->call($session, "got_task_stop");
}

sub child_process_failure {
    my ($self, $heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];
    my $task = $heap->{task};
    $task->{status} = "failed";
}

sub child_process_success {
    my ($self, $heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];
    my $task = $heap->{task};
    if (my $repeat_interval = $task->{repeat_interval}){
        if ($heap->{stopping}){
            $self->log("Will skip repeating the task, as task is stopping.");
        } else {
            $self->log("Will repeat the task");
            $task->{status} = "restarting";
            $kernel->yield("on_task_init");
        }
    } else {
        $self->debug("I'm going to stop this task");
        $kernel->yield("got_task_stop");
    }
}

#############################################################
#                                                           #
#      Methods for communicating with child processes       #
#                                                           #
#############################################################
# Originally inspired by the POE::Wheel::Run perldoc example

# Wheel event, including the wheel's ID
sub on_child_stdout {
    my ($self, $stdout_line, $wheel_id, $session) = @_[OBJECT, ARG0, ARG1, SESSION];
    my $child = $_[HEAP]{children_by_wid}{$wheel_id};
    #NOTE: Log everything child process sends to STDOUT
    $self->log("[pid ".$child->PID."] STDOUT: $stdout_line");

    #If the child outputs a line to STDOUT which starts with UPDATE_PARAMS=, we capture the data,
    #and update the task params.
    if ($stdout_line =~ /^UPDATE_PARAMS=(.*)$/){
        my $json_string = $1;
        my $json = from_json($json_string);
        my $task = $_[HEAP]->{task};
        my $params = $task->{params};
        foreach my $key (%$json){
            if (defined $params->{$key}){
                #FIXME: Don't just overwrite? Only update differences?
                $params->{$key} = $json->{$key};
            }
        }
        $_[HEAP]->{task} = $task;
    }
}

# Wheel event, including the wheel's ID.
sub on_child_stderr {
    my ($self, $stderr_line, $wheel_id, $session) = @_[OBJECT, ARG0, ARG1,SESSION];
    my $child = $_[HEAP]{children_by_wid}{$wheel_id};
    #NOTE: Log everything child process sends to STDERR
    $self->log("[pid ".$child->PID."] STDERR: $stderr_line");
}

# Wheel event, including the wheel's ID.
sub on_child_close {
    my ($self, $wheel_id,$session,$kernel) = @_[OBJECT, ARG0,SESSION,KERNEL];

    my $child = delete $_[HEAP]{children_by_wid}{$wheel_id};

    # May have been reaped by on_child_signal().
    unless (defined $child) {
        $self->debug("[wid $wheel_id] closed all pipes.");
        return;
    }
    $self->debug("[pid ".$child->PID."] closed all pipes.");
    delete $_[HEAP]{children_by_pid}{$child->PID};
}

sub on_child_signal {
    my ($self, $heap,$kernel,$pid,$exit_code,$session) = @_[OBJECT, HEAP,KERNEL,ARG1,ARG2,SESSION];

    #If the child's exit code is 0, handle this successful exit status
    if ($exit_code == 0){
        $kernel->yield("child_process_success");
    } else {
        $kernel->yield("child_process_failure");
    }
    $self->debug("pid $pid exited with status $exit_code.");
    my $child = delete $_[HEAP]{children_by_pid}{$pid};

    # May have been reaped by on_child_close().
    return unless defined $child;

    delete $_[HEAP]{children_by_wid}{$child->ID};
}

1;




package Koha::Icarus::Task::Base;

use Modern::Perl;
use IO::Select;

sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;
    return bless ($args, $class);
}

sub listen_for_instruction {
    my ($self) = @_;
    my $select = $self->{_select} ||= IO::Select->new(\*STDIN);
    if (my @ready_FHs  = $select->can_read(0) ){
        foreach my $FH (@ready_FHs){
            my $line = $FH->getline();
            chomp($line);
            return $line;
        }
    }
}

1;




package Koha::Icarus::Task::Download::OAIPMH::Biblio;

use Modern::Perl;
use parent 'Koha::Icarus::Task::Base';

use DateTime;
use DateTime::Format::Strptime;
use HTTP::OAI;
use File::Path qw(make_path);
use Digest::MD5;
use JSON;
use URI;

my $strp = DateTime::Format::Strptime->new(
        pattern   => '%Y%m%dT%H%M%S.%NZ',
);

my $oai_second_granularity = DateTime::Format::Strptime->new(
        pattern   => '%Y-%m-%dT%H:%M:%SZ',
);

my $oai_day_granularity = DateTime::Format::Strptime->new(
        pattern   => '%Y-%m-%d',
);

sub validate_parameter_names {

}
sub validate_repeat_interval {
    my ($self,$repeat_interval) = @_;
    if (defined $repeat_interval && $repeat_interval =~ /^\d+$/){
        return undef;
    }
    $self->{invalid_data}++;
    return { not_numeric => 1, };
}

sub validate_url {
    my ($self,$url) = @_;
    my $response = {};
    if (my $url_obj = URI->new($url)){
        if ($url_obj->scheme ne "http"){
            $response->{not_http} = 1;
            $self->{invalid_data}++;
        }
        if ( ! $url_obj->path){
            $response->{no_path} = 1;
            $self->{invalid_data}++;
        }
    } else {
        $response->{not_a_url} = 1;
        $self->{invalid_data}++;
    }

    return $response;
}

sub validate {
    my ($self, $args) = @_;
    #Reset the invalid data counter...
    $self->{invalid_data} = 0;
    my $errors = { };
    my $task = $self->{task};
    my $tests = $args->{tests};
    if ($task){
        if ($tests && $tests eq 'all'){
            #warn "PARAMS = ".$task->{params};
        }
    }
    my $params = $task->{params};

    #validate_start_time
    $errors->{"repeat_interval"} = $self->validate_repeat_interval($task->{repeat_interval});

    $errors->{"url"} = $self->validate_url($params->{url});

    #NOTE: You don't need to validate these 3 HTTP Basic Auth parameters
    #validate_username
    #validate_password
    #validate_realm

    #OAI-PMH parameters
    #validate_verb
    #validate_sets
    #validate_marcxml
    #validate_from
    #validate_until

    #Download parameters
    #validate_queue

    return $errors;
}

sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;
    $args->{invalid_data} = 0;
    return bless ($args, $class);
}

sub validate_queue {
    my ( $self ) = @_;
    my $task = $self->{task};
    if (my $queue = $task->{params}->{queue}){

        my $queue_uri = URI->new($queue);
        #TODO: In theory, you could even use a DBI DSN like DBI:mysql:database=koha;host=koha.db;port=3306.
        #Then you could provide the table, username, and password in the params as well...

        #NOTE: If the queue directory doesn't exist on the filesystem, we try to make it and change to it.
        if ($queue_uri->scheme eq 'file'){
            my $filepath = $queue_uri->file;
            if ( ! -d $filepath ){
                make_path($filepath,{ mode => 0755 });
            }
            if ( -d $filepath ){
                chdir $filepath or die "$!";
            }
        }

    }
}

sub run {
    my ( $self ) = @_;
    $self->validate_queue;

    my $task = $self->{task};

    #DEBUGGING/FIXME: Remove these lines
    if ($self->{Verbosity} && $self->{Verbosity} == 9){
        use Data::Dumper;
        warn Dumper($task);
    }

    my $params = $task->{params};

    my $now = DateTime->now(); #This is in UTC time, which is required by the OAI-PMH protocol.
    if ( $oai_second_granularity->parse_datetime($params->{from}) ){
        $now->set_formatter($oai_second_granularity);
    } else {
        $now->set_formatter($oai_day_granularity);
    }

    $params->{until}  = "$now" if $task->{repeat_interval};

    $self->{digester} = Digest::MD5->new();
    $self->create_harvester;
    my $sets = $self->prepare_sets;

    #Send a OAI-PMH request for each set
    foreach my $set (@{$sets}){
        my $response = $self->send_request({set => $set});
        $self->handle_response({ response => $response, set => $set,});
    }

    #FIXME: Do you want to update the task only when the task is finished, or
    #also after each resumption?
    #Update the task params in Icarus after the task is finished...
    #TODO: This really does make it seem like you should be handling the repeat_interval within the child process rather than the parent...
    if ($task->{repeat_interval}){
        $params->{from} = "$now";
        $params->{until} = "";
        my $json_update = to_json($params);
        say STDOUT "UPDATE_PARAMS=$json_update";
    }

}

#FIXME: I wonder if it would be faster to send your own HTTP requests and not use HTTP::OAI...
sub send_request {
    my ( $self, $args ) = @_;

    #NOTE: This is plugin specific as the plugins define when they stop to listen for instructions...
    #NOTE: Before sending a new request, check if Icarus has already asked us to quit.
    my $instruction = $self->listen_for_instruction();
    if ($instruction eq 'quit'){
        warn "I was asked to quit!";
        return;
    }

    my $set = $args->{set};
    my $resumptionToken = $args->{resumptionToken};

    my $response;
    my $task_params = $self->{task}->{params};

    my $harvester = $self->{harvester};
    my $verb = $task_params->{verb};
    if ($verb eq 'GetRecord'){
        $response = $harvester->GetRecord(
            metadataPrefix => $task_params->{metadataPrefix},
            identifier => $task_params->{identifier},
         );
    } elsif ($verb eq 'ListRecords'){
        $response = $harvester->ListRecords(
            metadataPrefix => $task_params->{metadataPrefix},
            from => $task_params->{from},
            until => $task_params->{until},
            set => $set,
            resumptionToken => $resumptionToken,
        );
    }
    return $response;
}

sub create_harvester {
    my ( $self ) = @_;
    my $task_params = $self->{task}->{params};

    #FIXME: DEBUGGING
    #use HTTP::OAI::Debug qw(+);

    #Create HTTP::OAI::Harvester object
    my $harvester = new HTTP::OAI::Harvester( baseURL => $task_params->{url} );
    if ($harvester){
        $harvester->timeout(5); #NOTE: the default timeout is 180
        #Set HTTP Basic Authentication Credentials
        my $uri = URI->new($task_params->{url});
        my $host = $uri->host;
        my $port = $uri->port;
        $harvester->credentials($host.":".$port, $task_params->{realm}, $task_params->{username}, $task_params->{password});
    }
    $self->{harvester} = $harvester;
}

sub prepare_sets {
    my ( $self ) = @_;
    my $task_params = $self->{task}->{params};
    my @sets = ();
    if ($task_params->{sets}){
        @sets = split(/\|/, $task_params->{sets});
    }
    #If no sets are defined, create a null element to force the foreach loop to run once
    if (!@sets){
        push(@sets,undef)
    }
    return \@sets;
}

sub handle_response {
    my ( $self, $args ) = @_;
    my $params = $self->{task}->{params};
    my $response = $args->{response};
    my $set = $args->{set};
    if ($response){
        #NOTE: We have options at this point
        #Option 1: Use $response->toDOM() to handle the XML response as a single document
        #Option 2: Use $response->next() to handle each record individually. You would need to create a new document using $rec->header->dom() and $rec->metadata->dom() anyway.

        #NOTE: I wonder which option would be the fastest. For now, we're going with Option 1:
        my $dom = $response->toDOM;
        my $root = $dom->documentElement;

        #FIXME: Provide these as arguments so you're not re-creating them for each response
        my $xpc = XML::LibXML::XPathContext->new();
        $xpc->registerNs('oai','http://www.openarchives.org/OAI/2.0/');
        my $xpath = XML::LibXML::XPathExpression->new("(oai:GetRecord|oai:ListRecords)/oai:record");


        my @records = $xpc->findnodes($xpath,$root);
        my $now_pretty = DateTime->now();

        $now_pretty->set_formatter($strp);
        print "Downloaded ".scalar @records." records at $now_pretty\n";
        foreach my $record (@records) {

            #FIXME: This is where you could put a filter to prevent certain records from being saved...

            #Create a new XML document from the XML fragment
            my $document = XML::LibXML::Document->new( "1.0", "UTF-8" );
            $document->setDocumentElement($record);
            my $record_string = $document->toString;

            #NOTE: We have options at this point.
            #Option 1: Write documents to disk, and have a separate importer upload the documents
            #Option 2: Use AnyEvent::HTTP or POE::Component::Client::HTTP to send to a HTTP API asynchronously
            #Option 3: Write records to a database, and have a separate importer upload the documents
            #Option 4: Shared memory, although that seems fragile if nothing else
            #Option 5: Write the records to a socket/pipe

            #NOTE: I wonder which option would be the fastest. For now, we're going to go with Option 1:
            $self->{digester}->add($record_string);
            my $digest = $self->{digester}->hexdigest;
            #FIXME: If a record appears more than once during the download signified by $now, you'll
            #overwrite the former with the latter. While this acts as a sort of heavy-handed de-duplication,
            #you need to take into account the importer daemon...

            require Time::HiRes;
            my $epoch = Time::HiRes::time();
            my $now = DateTime->from_epoch(epoch => $epoch);
            $now->set_formatter($strp);

            my $filename = "$now-$digest";
            #NOTE: Here is where we write the XML out to disk
            eval {
                my $state = $document->toFile($filename);
            };
            if ($@){
                die("Error while writing to disk: $@");
            }
        }


        #NOTE: Check if object has method due to bug in HTTP::OAI which causes fatal error on $response->resumptionToken if no real response is fetched from the OAI-PMH server
        if ($response->can("resumptionToken")){
            my $resumption_token = $response->resumptionToken->resumptionToken if $response->resumptionToken && $response->resumptionToken->resumptionToken;
            if ($resumption_token){
                #warn "Resumption Token = $resumption_token";
                my $resumed_response = $self->send_request({set => $set, resumptionToken => $resumption_token});
                $self->handle_response({ response => $resumed_response, set => $set,});
            }
        }

        #In theory $response->resume(resumptionToken => resumptionToken) should kick off another response...
        warn $response->message if $response->is_error;
    }
}

1;




package Koha::Icarus::Task::Upload::OAIPMH::Biblio;

use Modern::Perl;
use parent 'Koha::Icarus::Task::Base';
use URI;
use LWP::UserAgent;
use HTTP::Status qw(:constants);

my $ua = LWP::UserAgent->new;

#FIXME: If we store the cookie jar on disk, we can prevent unnecessary HTTP requests...
#We would need to make sure that it's stored on a private per-instance basis though...
$ua->cookie_jar({});


sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;
    return bless ($args, $class);
}

sub run {
    my ( $self ) = @_;

    my $task = $self->{task};

    if ($self->{Verbosity} && $self->{Verbosity} == 9){
        use Data::Dumper;
        warn Dumper($task);
    }

    my $params = $task->{params};




    my $queue = $params->{queue};
    my $queue_uri = URI->new($queue);

    if ($queue_uri->scheme eq 'file'){

        my $path = $queue_uri->path;
        opendir(my $dh, $path);
        my @files = sort readdir($dh);
        foreach my $file (@files){
            #NOTE: This is plugin specific as the plugins define when they stop to listen for instructions...
            my $instruction = $self->listen_for_instruction();
            if ($instruction eq 'quit'){
                warn "I was asked to quit!";
                return;
            }

            next if $file =~ /^\.+$/;
            my $filepath = "$path/$file";
            if ( -d $filepath ){
                #Do nothing for directories
            } elsif ( -e $filepath ){
                print "File: $file\n";

                #Slurp mode
                local $/;
                #TODO: Check flock on $filepath first
                open( my $fh, '<', $filepath );
                my $data   = <$fh>;

                #TODO: Improve this section...
                #Send to Koha API... (we could speed this up using Asynchronous HTTP requests with AnyEvent::HTTP...)
                my $resp = post_to_api($data,$params);

                my $status = $resp->code;

                if ($status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN) {
                    $resp = remote_authenticate($params);
                    $resp = post_to_api($data,$params) if $resp->is_success;
                }

                if ($resp->code == HTTP_OK){
                    print "Success.\n";
                    print $resp->decoded_content;
                    print "\n";
                    unlink $filepath;
                }
            }
        }
    }
}

sub post_to_api {
    my ($data, $params) = @_;
    print "Posting to API...\n";
    my $resp = $ua->post( $params->{target_uri},
                  {'nomatch_action' => $params->{nomatch_action},
                   'overlay_action' => $params->{overlay_action},
                   'match'          => $params->{match},
                   'import_mode'    => $params->{import_mode},
                   'framework'      => $params->{framework},
                   'item_action'    => $params->{item_action},
                   'filter'         => $params->{filter},
                   'xml'            => $data}
    );
    return $resp;
}

sub remote_authenticate {
    my ($params) = @_;
    print "Authenticating...\n";

    my $auth_uri = $params->{auth_uri};
    my $user = $params->{auth_username};
    my $password = $params->{auth_password};
    my $resp = $ua->post( $auth_uri, { userid => $user, password => $password } );
    if ($resp->code == HTTP_OK){
        print "Authenticated.\n";
    }
    return $resp
}

1;




package Koha::SavedTask;

# Copyright Prosentient Systems 2016
#
# This file is part of Koha.
#
# Koha 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.
#
# Koha 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 Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;

use Carp;

use JSON;

use base qw(Koha::Object);



=head1 NAME

Koha::SavedTask -

=head1 API

=head2 Class Methods

=cut



=head3 _type

=cut

sub _type {
    return 'SavedTask';
}

sub params_as_perl {
    my ($self) = @_;
    my $perl = from_json($self->params);
    return $perl;
}

sub serialize {
    my ($self,$args) = @_;
    my $for = $args->{for};
    my $type = $args->{type};
    if ($for eq 'icarus'){
        my $json_params = $self->params;
        my $perl_params = from_json($json_params);

        my $icarus_task = {
            type => $self->task_type,
            start => $self->start_time,
            repeat_interval => $self->repeat_interval,
            params => $perl_params,
        };
        if ($type eq 'perl'){
            return  $icarus_task;
        } elsif ($type eq 'json'){
            my $json = to_json($icarus_task);
            return $json;
        }
    }
    return undef;
}

=head1 AUTHOR

David Cook <dcook@prosentient.com.au>

=cut

1;




package Koha::SavedTasks;

# Copyright Prosentient Systems 2016
#
# This file is part of Koha.
#
# Koha 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.
#
# Koha 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 Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;

use Carp;

use Koha::Database;

use Koha::SavedTask;

use base qw(Koha::Objects);

=head1 NAME

Koha::SavedTasks -

=head1 API

=head2 Class Methods

=cut

=head3 _type

=cut

sub _type {
    return 'SavedTask';
}

=head3 object_class

=cut

sub object_class {
    return 'Koha::SavedTask';
}

=head1 AUTHOR

David Cook <dcook@prosentient.com.au>

=cut

1;




use utf8;
package Koha::Schema::Result::SavedTask;

# Created by DBIx::Class::Schema::Loader
# DO NOT MODIFY THE FIRST PART OF THIS FILE

=head1 NAME

Koha::Schema::Result::SavedTask

=cut

use strict;
use warnings;

use base 'DBIx::Class::Core';

=head1 TABLE: C<saved_tasks>

=cut

__PACKAGE__->table("saved_tasks");

=head1 ACCESSORS

=head2 task_id

  data_type: 'integer'
  extra: {unsigned => 1}
  is_auto_increment: 1
  is_nullable: 0

=head2 start_time

  data_type: 'datetime'
  datetime_undef_if_invalid: 1
  is_nullable: 0

=head2 repeat_interval

  data_type: 'integer'
  extra: {unsigned => 1}
  is_nullable: 0

=head2 task_type

  data_type: 'varchar'
  is_nullable: 0
  size: 255

=head2 params

  data_type: 'text'
  is_nullable: 0

=cut

__PACKAGE__->add_columns(
  "task_id",
  {
    data_type => "integer",
    extra => { unsigned => 1 },
    is_auto_increment => 1,
    is_nullable => 0,
  },
  "start_time",
  {
    data_type => "datetime",
    datetime_undef_if_invalid => 1,
    is_nullable => 0,
  },
  "repeat_interval",
  { data_type => "integer", extra => { unsigned => 1 }, is_nullable => 0 },
  "task_type",
  { data_type => "varchar", is_nullable => 0, size => 255 },
  "params",
  { data_type => "text", is_nullable => 0 },
);

=head1 PRIMARY KEY

=over 4

=item * L</task_id>

=back

=cut

__PACKAGE__->set_primary_key("task_id");


# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-01-27 13:35:22
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:gnoi7I9fiXM3IfDysMTm+A


# You can replace this text with custom code or comments, and it will be preserved on regeneration
1;

Lines 198-203 Directory for Zebra's data files. Link Here

(-)a/Makefile.PL (-1 / +18 lines)
198		198
199	Directory for Zebra's UNIX-domain sockets.	199	Directory for Zebra's UNIX-domain sockets.
200		200
		201	=item ICARUS_RUN_DIR
		202
		203	Directory for Icarus's UNIX-domain socket and pid file.
		204
201	=item MISC_DIR	205	=item MISC_DIR
202		206
203	Directory for for miscellaenous scripts, among other	207	Directory for for miscellaenous scripts, among other
Lines 317-322 my $target_map = { Link Here
317	'./skel/var/log/koha' => { target => 'LOG_DIR', trimdir => -1 },	321	'./skel/var/log/koha' => { target => 'LOG_DIR', trimdir => -1 },
318	'./skel/var/spool/koha' => { target => 'BACKUP_DIR', trimdir => -1 },	322	'./skel/var/spool/koha' => { target => 'BACKUP_DIR', trimdir => -1 },
319	'./skel/var/run/koha/zebradb' => { target => 'ZEBRA_RUN_DIR', trimdir => -1 },	323	'./skel/var/run/koha/zebradb' => { target => 'ZEBRA_RUN_DIR', trimdir => -1 },
		324	'./skel/var/run/koha/icarus' => { target => 'ICARUS_RUN_DIR', trimdir => 6 },
320	'./skel/var/lock/koha/zebradb/authorities' => { target => 'ZEBRA_LOCK_DIR', trimdir => 6 },	325	'./skel/var/lock/koha/zebradb/authorities' => { target => 'ZEBRA_LOCK_DIR', trimdir => 6 },
321	'./skel/var/lib/koha/zebradb/authorities/key' => { target => 'ZEBRA_DATA_DIR', trimdir => 6 },	326	'./skel/var/lib/koha/zebradb/authorities/key' => { target => 'ZEBRA_DATA_DIR', trimdir => 6 },
322	'./skel/var/lib/koha/zebradb/authorities/register' => { target => 'ZEBRA_DATA_DIR', trimdir => 6 },	327	'./skel/var/lib/koha/zebradb/authorities/register' => { target => 'ZEBRA_DATA_DIR', trimdir => 6 },
Lines 414-419 System user account that will own Koha's files. Link Here
414		419
415	System group that will own Koha's files.	420	System group that will own Koha's files.
416		421
		422	=item ICARUS_MAX_TASKS
		423
		424	Maximum number of tasks allowed by Icarus.
		425
417	=back	426	=back
418		427
419	=cut	428	=cut
Lines 448-454 my %config_defaults = ( Link Here
448	'USE_MEMCACHED' => 'no',	457	'USE_MEMCACHED' => 'no',
449	'MEMCACHED_SERVERS' => '127.0.0.1:11211',	458	'MEMCACHED_SERVERS' => '127.0.0.1:11211',
450	'MEMCACHED_NAMESPACE' => 'KOHA',	459	'MEMCACHED_NAMESPACE' => 'KOHA',
451	'FONT_DIR' => '/usr/share/fonts/truetype/ttf-dejavu'	460	'FONT_DIR' => '/usr/share/fonts/truetype/ttf-dejavu',
		461	'ICARUS_MAX_TASKS' => '30',
452	);	462	);
453		463
454	# set some default configuration options based on OS	464	# set some default configuration options based on OS
Lines 1092-1097 Memcached namespace?); Link Here
1092	Path to DejaVu fonts?);	1102	Path to DejaVu fonts?);
1093	$config{'FONT_DIR'} = _get_value('FONT_DIR', $msg, $defaults->{'FONT_DIR'}, $valid_values, $install_log_values);	1103	$config{'FONT_DIR'} = _get_value('FONT_DIR', $msg, $defaults->{'FONT_DIR'}, $valid_values, $install_log_values);
1094		1104
		1105	$msg = q(
		1106	Maximum number of tasks allowed by Icarus?);
		1107	$config{'ICARUS_MAX_TASKS'} = _get_value('ICARUS_MAX_TASKS', $msg, $defaults->{'ICARUS_MAX_TASKS'}, $valid_values, $install_log_values);
		1108
1095		1109
1096	$msg = q(	1110	$msg = q(
1097	Would you like to run the database-dependent test suite?);	1111	Would you like to run the database-dependent test suite?);
Lines 1241-1246 sub get_target_directories { Link Here
1241	$dirmap{'PLUGINS_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'koha', 'plugins');	1255	$dirmap{'PLUGINS_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'koha', 'plugins');
1242	$dirmap{'ZEBRA_DATA_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'zebradb');	1256	$dirmap{'ZEBRA_DATA_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'zebradb');
1243	$dirmap{'ZEBRA_RUN_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'run', 'zebradb');	1257	$dirmap{'ZEBRA_RUN_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'run', 'zebradb');
		1258	$dirmap{'ICARUS_RUN_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'run', 'icarus');
1244	} elsif ($mode eq 'dev') {	1259	} elsif ($mode eq 'dev') {
1245	my $curdir = File::Spec->rel2abs(File::Spec->curdir());	1260	my $curdir = File::Spec->rel2abs(File::Spec->curdir());
1246	$dirmap{'API_CGI_DIR'} = File::Spec->catdir($curdir, 'api');	1261	$dirmap{'API_CGI_DIR'} = File::Spec->catdir($curdir, 'api');
Lines 1276-1281 sub get_target_directories { Link Here
1276	$dirmap{'PLUGINS_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'plugins');	1291	$dirmap{'PLUGINS_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'plugins');
1277	$dirmap{'ZEBRA_DATA_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'zebradb');	1292	$dirmap{'ZEBRA_DATA_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'lib', 'zebradb');
1278	$dirmap{'ZEBRA_RUN_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'run', 'zebradb');	1293	$dirmap{'ZEBRA_RUN_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'run', 'zebradb');
		1294	$dirmap{'ICARUS_RUN_DIR'} = File::Spec->catdir(@basedir, $package, 'var', 'run', 'icarus');
1279	} else {	1295	} else {
1280	# mode is standard, i.e., 'fhs'	1296	# mode is standard, i.e., 'fhs'
1281	$dirmap{'API_CGI_DIR'} = File::Spec->catdir(@basedir, $package, 'api');	1297	$dirmap{'API_CGI_DIR'} = File::Spec->catdir(@basedir, $package, 'api');
Lines 1300-1305 sub get_target_directories { Link Here
1300	$dirmap{'PLUGINS_DIR'} = File::Spec->catdir(File::Spec->rootdir(), 'var', 'lib', $package, 'plugins');	1316	$dirmap{'PLUGINS_DIR'} = File::Spec->catdir(File::Spec->rootdir(), 'var', 'lib', $package, 'plugins');
1301	$dirmap{'ZEBRA_DATA_DIR'} = File::Spec->catdir(File::Spec->rootdir(), 'var', 'lib', $package, 'zebradb');	1317	$dirmap{'ZEBRA_DATA_DIR'} = File::Spec->catdir(File::Spec->rootdir(), 'var', 'lib', $package, 'zebradb');
1302	$dirmap{'ZEBRA_RUN_DIR'} = File::Spec->catdir(File::Spec->rootdir(), 'var', 'run', $package, 'zebradb');	1318	$dirmap{'ZEBRA_RUN_DIR'} = File::Spec->catdir(File::Spec->rootdir(), 'var', 'run', $package, 'zebradb');
		1319	$dirmap{'ICARUS_RUN_DIR'} = File::Spec->catdir(File::Spec->rootdir(), 'var', 'run', $package, 'icarus');
1303	}	1320	}
1304		1321
1305	_get_env_overrides(\%dirmap);	1322	_get_env_overrides(\%dirmap);




#!/usr/bin/perl

# Copyright Prosentient Systems 2016
#
# This file is part of Koha.
#
# Koha 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.
#
# Koha 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 Koha; if not, see <http://www.gnu.org/licenses>.

=head1 NAME

saved_tasks.pl

=head1 DESCRIPTION

Admin page to manage saved tasks

=cut

use Modern::Perl;
use CGI qw ( -utf8 );
use C4::Auth;
use C4::Output;
use C4::Context;

use Koha::SavedTasks;
use Koha::Icarus;
use Module::Load::Conditional qw/can_load check_install/;
use JSON;

my $try_to_connect = 1;
my $input = new CGI;
my ($template, $loggedinuser, $cookie, $flags) = get_template_and_user( {
    template_name   => 'admin/saved_tasks.tt',
    query           => $input,
    type            => 'intranet',
    authnotrequired => 0,
    flagsrequired   => { 'parameters' => 'parameters_remaining_permissions' },
} );

my $filename = "saved_tasks.pl";
$template->param(
    filename => $filename,
);

my $context = C4::Context->new();


my $task_server = $input->param("task_server") // "icarus";


my $socket_uri = $context->{"icarus"}->{"socket"};

my @available_plugins = ();
my $task_plugins = $context->{"icarus"}->{"task_plugin"};
if ($task_plugins && ref $task_plugins eq 'ARRAY'){
    #FIXME: This should probably be a module method... validation that a plugin is installed...
    foreach my $task_plugin (@$task_plugins){
        #Check that plugin module is installed
        if ( check_install( module => $task_plugin ) ){
                push(@available_plugins,$task_plugin);
        }
    }
}

$template->param(
    available_plugins => \@available_plugins,
);

#Server action and task id
my $server_action = $input->param("server_action");
my $server_task_id = $input->param('server_task_id');

#Saved task op
my $op = $input->param('op');
my $step = $input->param('step');

#Saved task id
my $saved_task_id = $input->param('saved_task_id');


#Create Koha-Icarus interface object
my $icarus = Koha::Icarus->new({ socket_uri => $socket_uri });
my $daemon_status = "";



#NOTE: If you're having problems starting the server from the web ui,
#remember that Apache must be able to write to icarus.log, icarus.pid, icarus.sock and the directories containing them.
if ($server_action && $server_action eq "start_server" ){
    my $icarusd = $context->{icarus}->{bin};
    my $KOHA_CONF = $ENV{'KOHA_CONF'};
    if ( -f $icarusd && $KOHA_CONF){
        my $start_daemon = "$icarusd -f $KOHA_CONF --daemon -v 9";
            #NOTE: If the daemon didn't close STDOUT and STDERR itself, we'd need to redirect them to /dev/null them here to prevent Apache from looping/erroring
            if (system("$start_daemon") == 0){
                #This means the parent daemon process succeeded. However, it's still possible that the child daemon process has failed.
            } else {
                $try_to_connect = 0;
                $daemon_status = "Start failed";
            }
    }
}

if ($try_to_connect){
    #Connect to Icarus
    if ( $icarus->connect() ){
        $daemon_status = "online";
        if ($server_action){
            if ($server_action eq 'shutdown_server'){
                my $response = $icarus->shutdown;
                if ( $response && (my $action = $response->{action}) ){
                    $daemon_status = $action;
                }
            } elsif ($server_action eq 'start' && $server_task_id){
                my $response = $icarus->start_task({ task_id => $server_task_id });
                $template->param(
                    task_response => $response,
                );
            } elsif ($server_action eq 'remove' && $server_task_id){
                my $response = $icarus->remove_task({ task_id => $server_task_id });
                $template->param(
                    task_response => $response,
                );
            }
        }
    } else {
        warn "Daemon status: $!";
        $daemon_status = $!;
    }
}

$template->param(
    daemon_status => $daemon_status,
);



my $params = $input->param("params");

#NOTE: Parse the parameters manually, so that you can "name[]" style of parameter, which we use in the special plugin templates...
my $saved_params = {};
#Fetch the names of all the parameters passed to your script
my @parameter_names = $input->param;
#Iterate through these parameter names and look for "params[]"
foreach my $parameter_name (@parameter_names){
    if ($parameter_name =~ /^params\[(.*)\]$/){
        #Capture the hash key
        my $key = $1;
        #Fetch the actual individual value
        my $parameter_value = $input->param($parameter_name);
        if ($parameter_value){
            $saved_params->{$key} = $parameter_value;
        }
    }
}
if (%$saved_params){
    my $json = to_json($saved_params, { pretty => 1, });
    if ($json){
        $params = $json;
    }
}

my $start_time = $input->param("start_time");
my $repeat_interval = $input->param("repeat_interval");
my $task_type = $input->param("task_type");
if ($task_type){
    my $task_template = $task_type;
    #Create the template name by stripping the colons out of the task type text
    $task_template =~ s/://g;
    $template->param(
        task_template => "tasks/$task_template.inc",
    );
}


if ($op){
    if ($op eq 'new'){

    } elsif ($op eq 'create'){

        #Validate the $task here
        if ($step){
            if ($step eq "one"){

                $op = "new";
                $template->param(
                    step => "two",
                    task_type => $task_type,
                );
            } elsif ($step eq "two"){
                my $new_task = Koha::SavedTask->new({
                    start_time => $start_time,
                    repeat_interval => $repeat_interval,
                    task_type => $task_type,
                    params => $params,
                });

                #Serialize the data as an Icarus task
                my $icarus_task = $new_task->serialize({ for => "icarus", type => "perl", });

                my $valid = 1;
                #Load the plugin module, and create an object instance in order to validate user-entered data
                if ( can_load( modules => { $task_type => undef, }, ) ){
                    my $plugin = $task_type->new({ task => $icarus_task, });
                    if ($plugin->can("validate")){
                        my $errors = $plugin->validate({
                            "tests" => "all",
                        });
                        if (%$errors){
                            $template->param(
                                errors => $errors,
                            );
                        }
                        if ($plugin->{invalid_data} > 0){
                            $valid = 0;
                        }
                    }
                }

                if ($valid){
                    $new_task->store();
                    $op = "list";
                } else {
                    $op = "new";
                    #Create a Perl data structure from the JSON
                    my $editable_params = from_json($params);
                    $template->param(
                        step => "two",
                        task_type => $task_type,
                        saved_task => $new_task,
                        params => $editable_params,
                    );
                }
            }
        }

    } elsif ($op eq 'edit'){
        my $task = Koha::SavedTasks->find($saved_task_id);
        if ($task){
            #Check if the task's saved task type is actually available...
            #FIXME: This should be a Koha::Icarus method...
            my $task_type_is_valid = grep { $task->task_type eq $_ } @available_plugins;
            $template->param(
                task_type_is_valid => $task_type_is_valid,
                saved_task => $task,
            );
        }
    } elsif ($op eq 'update'){
        if ($step){
            my $task = Koha::SavedTasks->find($saved_task_id);
            if ($task){
                if ($step eq "one"){
                    #We've completed step one, which is choosing the task type,
                    #so now we're going to populate the form for editing the rest of the values
                    $op = "edit";
                    #This is the JSON string that we've saved in the database
                    my $current_params_string = $task->params;
                    my $editable_params = from_json($current_params_string);

                    $template->param(
                        step => "two",
                        task_type => $task_type,
                        saved_task => $task,
                        params => $editable_params,

                    );
                } elsif ($step eq "two"){
                    #We've completed step two, so we're storing the data now...
                    $task->set({
                        start_time => $start_time,
                        repeat_interval => $repeat_interval,
                        task_type => $task_type,
                        params => $params,
                    });
                    $task->store;
                    #FIXME: Validate the $task here...
                    if (my $valid = 1){
                        $op = "list";
                    } else {
                        $op = "edit";
                        $template->param(
                            step => "two",
                            task_type => $task_type,
                            saved_task => $task,
                        );
                    }
                }
            }
        }
    } elsif ($op eq 'send'){
        my $sent_response;
        if ($icarus->connected){
            if ($saved_task_id){
                #Look up task
                my $task = Koha::SavedTasks->find($saved_task_id);
                if ($task){
                    #Create a task for Icarus, and send it to Icarus
                    my $icarus_task = $task->serialize({ for => "icarus", type => "perl", });
                    if ($icarus_task){
                        $icarus->add_task({ task => $icarus_task, });
                        $op = "list";
                    }
                }
            }
        } else {
            $sent_response = "icarus_offline";
            $template->param(
                sent_response => $sent_response,
            );
            $op = "list";
        }
    } elsif ($op eq 'delete'){
        my $saved_response = "delete_failure";
        if ($saved_task_id){
            #Look up task
            my $task = Koha::SavedTasks->find($saved_task_id);
            if ($task){
                if (my $something = $task->delete){
                    $saved_response = "delete_success";
                }
            }
        }
        $template->param(
            saved_response => $saved_response,
        );
        $op = "list";
    } else {
        #Don't recognize $op, so fallback to list
        $op = "list";
    }
} else {
    #No $op, so fallback to list
    $op = "list";
}

if ($op eq 'list'){
    #Get active tasks from Icarus
    if ($icarus->connected){
        my $tasks = $icarus->list_tasks();
        if ($tasks && @$tasks){
            #Sort tasks that come from Icarus, since it returns an unsorted list of hashrefs
            my @sorted_tasks = sort { $a->{task_id} <=> $b->{task_id} } @$tasks;
            $template->param(
                tasks => \@sorted_tasks,
            );
        }
    }

    #Get saved tasks from Koha
    my @saved_tasks = Koha::SavedTasks->as_list();
    $template->param(
        saved_tasks => \@saved_tasks,
    );
}

$template->param(
    op => $op,
);

output_html_with_http_headers $input, $cookie, $template->output;




TODO:

_ICARUS_
- Improve error handling for Koha::Icarus::Task::Upload::*
    - When does it get a status of "Failed"?
- Data validation:
    "Koha::Icarus::Task::Upload::OAIPMH::Biblio":
        - Validate HTTP URLs and filepaths...
        - MAKE IT SO YOU HAVE TO USE A RECORD MATCHING RULE! To at the very least strip the OAI wrapper...
    - Add PLUGIN->validate("parameter_names")
    - Add PLUGIN->validate("parameter_values")
        - For the downloader, this would validate HTTP && OAI-PMH parameters...

#######

ICARUS:
- admin/saved_tasks.pl
    - Add a clone button to ease task creation
- Make the "Task type" prettier (and translateable) on saved_tasks.pl.
- Provide more options for the Icarus dashboard? (already have start/shutdown...)
- Add the ability to "edit" and "pause" active Icarus tasks
    - A pause function would make debugging much easier.
- Add help pages for WEB GUI
- Make "Koha::Icarus::Task::Upload::OAIPMH::Biblio" use asynchronous HTTP requests to speed up the import
- Instead of using file:///home/koha/koha-dev/var/spool/oaipmh, use something like file:///tmp/koha-instance/koha-dev/oaipmh
    - How is the user going to specify file:///tmp/koha-instance/koha-dev/oaipmh? Or do you put this in koha-conf.xml and then make a user-defined relative path?
- WEB UI:
    - Add `name` to saved_tasks?
- Move "Saved tasks" from Administration to Tools?
    - Look at existing bugs for schedulers:
        - https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=14712
        - https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=1993
- Handle datestamp granularity better for OAI-PMH download tasks?



Lines 137-140 __PAZPAR2_TOGGLE_XML_POST__ Link Here

(-)a/etc/koha-conf.xml (+9 lines)
137	</ttf>	137	</ttf>
138		138
139	</config>	139	</config>
		140	<icarus>
		141	<bin>__SCRIPT_DIR__/icarusd.pl</bin>
		142	<socket>unix:__ICARUS_RUN_DIR__/icarus.sock</socket>
		143	<pidfile>__ICARUS_RUN_DIR__/icarus.pid</pidfile>
		144	<log>__LOG_DIR__/icarus.log</log>
		145	<task_plugin>Koha::Icarus::Task::Download::OAIPMH::Biblio</task_plugin>
		146	<task_plugin>Koha::Icarus::Task::Upload::OAIPMH::Biblio</task_plugin>
		147	<max_tasks>__ICARUS_MAX_TASKS__</max_tasks>
		148	</icarus>
140	</yazgfs>	149	</yazgfs>

Line 0 Link Here

(-)a/installer/data/mysql/atomicupdate/bug_10662-Icarus.sql (+9 lines)
	1	DROP TABLE IF EXISTS saved_tasks;
	2	CREATE TABLE saved_tasks (
	3	task_id int(10) unsigned NOT NULL AUTO_INCREMENT,
	4	start_time datetime NOT NULL,
	5	repeat_interval int(10) unsigned NOT NULL,
	6	task_type varchar(255) CHARACTER SET utf8 NOT NULL,
	7	params text CHARACTER SET utf8 NOT NULL,
	8	PRIMARY KEY (task_id) USING BTREE
	9	) ENGINE=InnoDB AUTO_INCREMENT=1 DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;

Lines 78-83 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc (+1 lines)
78	[% IF Koha.Preference('SMSSendDriver') == 'Email' %]	78	[% IF Koha.Preference('SMSSendDriver') == 'Email' %]
79	<li><a href="/cgi-bin/koha/admin/sms_providers.pl">SMS cellular providers</a></li>	79	<li><a href="/cgi-bin/koha/admin/sms_providers.pl">SMS cellular providers</a></li>
80	[% END %]	80	[% END %]
		81	<li><a href="/cgi-bin/koha/admin/saved_tasks.pl">Saved tasks</a></li>
81	</ul>	82	</ul>
82	</div>	83	</div>
83	</div>	84	</div>




[%# USE CGI %]
[%# server_name = CGI.server_name; server_port = CGI.server_port; server = server_name _ ":" _ server_port; %]

<fieldset class="rows">
    <legend>HTTP parameters:</legend>
    <ol>
        <li>
            <label for="url">URL: </label>
            [% IF ( params.url ) %]
                <input type="text" id="url" name="params[url]" value="[% params.url %]" size="30" />
            [% ELSE %]
                <input type="text" id="url" name="params[url]" value="http://" size="30" />
            [% END %]
            [% IF (errors.url.no_path) %]<span class="error">[The URL must have a path after "http://" like "koha-community.org/cgi-bin/koha/oai.pl".]</span>[% END %]
            [% IF (errors.url.not_http) %]<span class="error">[The URL begin with a scheme of "http://" like "http://koha-community.org/cgi-bin/koha/oai.pl".]</span>[% END %]
            [% IF (errors.url.not_a_url) %]<span class="error">[The value of this field must be a URL like "http://koha-community.org/cgi-bin/koha/oai.pl".]</span>[% END %]

        </li>
    </ol>
    <span class="help">The following parameters are not required by all OAI-PMH repositories, so they may be optional for this task.</span>
    <ol>
        <li>
            <label for="username">Username: </label>
            <input type="text" id="username" name="params[username]" value="[% params.username %]" size="30" />
        </li>
        <li>
            <label for="password">Password: </label>
            <input type="text" id="password" name="params[password]" value="[% params.password %]" size="30" />
        </li>
        <li>
            <label for="realm">Realm: </label>
            <input type="text" id="realm" name="params[realm]" value="[% params.realm %]" size="30" />
        </li>
    </ol>
</fieldset>
<fieldset class="rows">
    <legend>OAI-PMH parameters:</legend>
    <ol>
        <li>
            <label for="verb">Verb: </label>
            <select id="verb" name="params[verb]">
            [% FOREACH verb IN [ 'GetRecord', 'ListRecords' ] %]
                [% IF ( params.verb ) && ( verb == params.verb ) %]
                    <option selected="selected" value="[% verb %]">[% verb %]</option>
                [% ELSE %]
                    <option value="[% verb %]">[% verb %]</option>
                [% END %]
            [% END %]
            </select>
        </li>
        <li>
            <label for="identifier">Identifier: </label>
            <input type="text" id="identifier" name="params[identifier]" value="[% params.identifier %]" size="30" />
            <span class="help">This identifier will only be used with the GetRecord verb.</span>
        </li>
        <li>
            <label for="sets">Sets: </label>
            <input type="text" id="sets" name="params[sets]" value="[% params.sets %]" size="30" /><span class="help">You may specify several sets by separating the sets with a pipe (e.g. set1|set2 )</span>
        </li>
        <li>
            <label for="metadataPrefix">Metadata Prefix: </label>
            <input type="text" id="metadataPrefix" name="params[metadataPrefix]" value="[% params.metadataPrefix %]" size="30" />
        </li>
        <li>
            <label for="opt_from">From: </label>
            <input type="text" class="datetime_utc" id="opt_from" name="params[from]" value="[% params.from %]" size="30" /><span class="help">This value will be treated as UTC time. Note that some repositories only support YYYY-MM-DD datestamps.</span>
        </li>
        <li>
            <label for="opt_until">Until: </label>
            <input type="text" class="datetime_utc" id="opt_until" name="params[until]" value="[% params.until %]" size="30" /><span class="help">This value will be treated as UTC time. Note that some repositories only support YYYY-MM-DD datestamps.</span>
        </li>
    </ol>
</fieldset>
<fieldset class="rows">
    <legend>Download parameters:</legend>
    <ol>
        <li>
            <label for="queue">Queue: </label>
            [% IF ( params.queue ) %]
                <input type="text" id="queue" name="params[queue]" value="[% params.queue %]" size="30" />
            [% ELSE %]
                <input type="text" id="queue" name="params[queue]" value="file://" size="30" />
            [% END %]
            <span class="help">This is a filepath on your system like file:///var/spool/koha/libraryname/oaipmh</span>
        </li>
    </ol>
</fieldset>




[%# Use CGI plugin to create a default target URI %]
[%# TODO: Test if this works with Plack... %]
[% USE CGI %]
[% server = CGI.virtual_host %]
[% IF ( server_port = CGI.virtual_port ) %]
        [% IF ( server_port != '80' ) && ( server_port != '443' ) %]
                [% server = server _ ':' _ server_port %]
        [% END %]
[% END %]
[% default_auth_uri = 'http://' _ server _ '/cgi-bin/koha/svc/authentication' %]
[% default_target_uri = 'http://' _ server _ '/cgi-bin/koha/svc/import_oai' %]
<fieldset class="rows">
    <legend>Import source parameters:</legend>
    <ol>
        <li>
            <label for="queue">Queue: </label>
            [% IF ( params.queue ) %]
                <input type="text" id="queue" name="params[queue]" value="[% params.queue %]" size="30" />
            [% ELSE %]
                <input type="text" id="queue" name="params[queue]" value="file://" size="30" />
            [% END %]
            <span class="help">This is a filepath on your system like file:///var/spool/koha/libraryname/oaipmh</span>
        </li>
    </ol>
</fieldset>
<fieldset class="rows">
    <legend>API authentication parameters:</legend>
    <ol>
        <li>
            <label for="auth_uri">URL: </label>
            [% IF ( params.auth_uri ) %]
                <input type="text" id="auth_uri" name="params[auth_uri]" value="[% params.auth_uri %]" size="30" />
            [% ELSE %]
                <input type="text" id="auth_uri" name="params[auth_uri]" value="[% default_auth_uri %]" size="30" />
            [% END %]
            [% IF (errors.auth_uri.no_path) %]<span class="error">[The URL must have a path after "http://" like "koha-community.org/cgi-bin/koha/svc/authentication".]</span>[% END %]
            [% IF (errors.auth_uri.not_http) %]<span class="error">[The URL begin with a scheme of "http://" like "http://koha-community.org/cgi-bin/koha/svc/authentication".]</span>[% END %]
            [% IF (errors.auth_uri.not_a_url) %]<span class="error">[The value of this field must be a URL like "http://koha-community.org/cgi-bin/koha/svc/authentication".]</span>[% END %]
            <span class="help">This is a Koha authentication URL. The default value </span>
        </li>
        <li>
            <label for="auth_username">Username: </label>
            <input type="text" id="auth_username" name="params[auth_username]" value="[% params.auth_username %]" size="30" />
            <span class="help">This user must have permission to edit the catalogue.</span>
        </li>
        <li>
            <label for="auth_password">Password: </label>
            <input type="text" id="auth_password" name="params[auth_password]" value="[% params.auth_password %]" size="30" />
        </li>
    </ol>
</fieldset>
<fieldset class="rows">
    <legend>Import target parameters:</legend>
    <ol>
        <li>
            <label for="target_uri">URL: </label>
            [% IF ( params.target_uri ) %]
                <input type="text" id="target_uri" name="params[target_uri]" value="[% params.target_uri %]" size="30" />
            [% ELSE %]
                <input type="text" id="target_uri" name="params[target_uri]" value="[% default_target_uri %]" size="30" />
            [% END %]
            [% IF (errors.target_uri.no_path) %]<span class="error">[The URL must have a path after "http://" like "koha-community.org/cgi-bin/koha/svc/import_oai".]</span>[% END %]
            [% IF (errors.target_uri.not_http) %]<span class="error">[The URL begin with a scheme of "http://" like "http://koha-community.org/cgi-bin/koha/svc/import_oai".]</span>[% END %]
            [% IF (errors.target_uri.not_a_url) %]<span class="error">[The value of this field must be a URL like "http://koha-community.org/cgi-bin/koha/svc/import_oai".]</span>[% END %]
        </li>

        <li>
            <label for="match">Record matching rule code</label>
            <input type="text" id="match" name="params[match]" value="[% params.match %]" size="30" />
            <span class="help">This code must exist in "Record matching rules" in Administration for record matching to work. (Example code: OAI)</span>
        </li>
        <li>
            [%# TODO: Ideally, I'd like to use 'tools-overlay-action.inc' but the logic doesn't work here. Perhaps it would be better as a TT plugin. %]
            <label for="overlay_action">Action if matching record found</label>
            <select name="params[overlay_action]" id="overlay_action">
            [% IF ( params.overlay_action == "replace" ) %]
                <option value="replace"  selected="selected">
            [% ELSE %]
                <option value="replace">
            [% END %]
                Replace existing record with incoming record</option>
            [% IF ( params.overlay_action == "create_new" ) %]
                <option value="create_new" selected="selected">
            [% ELSE %]
                <option value="create_new">
            [% END %]
                Add incoming record</option>
            [% IF ( params.overlay_action == "ignore" ) %]
                <option value="ignore" selected="selected">
            [% ELSE %]
                <option value="ignore">
            [% END %]
                Ignore incoming record</option>
            </select>
        </li>
        <li>
            [%# TODO: Ideally, I'd like to use 'tools-nomatch-action.inc' but the logic doesn't work here. Perhaps it would be better as a TT plugin. %]
            <label for="nomatch_action">Action if no match is found</label>
            <select name="params[nomatch_action]" id="nomatch_action">
            [% IF ( params.nomatch_action == "create_new" ) %]
                <option value="create_new" selected="selected">
            [% ELSE %]
                <option value="create_new">
            [% END %]
                Add incoming record</option>
            [% IF ( params.nomatch_action == "ignore" ) %]
                <option value="ignore" selected="selected">
            [% ELSE %]
                <option value="ignore">
            [% END %]
                Ignore incoming record</option>
            </select>
        </li>
        <li>
            <label for="item_action">Item action</label>
            [%# TODO: Will you ever have a different mode than ignore? %]
            <input type="text" id="item_action"  value="ignore" size="30" disabled="disabled"/>
            <input type="hidden" name="params[item_action]" value="ignore" />
        </li>
        <li>
            <label for="import_mode">Import mode: </label>
            [%# TODO: Will you ever have a different mode than direct? %]
            <input type="text" id="import_mode" value="direct" size="30" disabled="disabled"/>
            <input type="hidden" name="params[import_mode]" value="direct" />
        </li>
        <li>
            <label>Framework</label>
        </li>
        <li>
            <label for="filter">Filter</label>
            [% IF ( params.filter ) %]
                <input type="text" id="filter" name="params[filter]" value="[% params.filter %]" size="30" />
            [% ELSE %]
                <input type="text" id="filter" name="params[filter]" value="file://" size="30" />
            [% END %]
            <span class="help">This is a filepath on your system like file:///etc/koha/sites/libraryname/OAI2MARC21slim.xsl or file:///usr/share/koha/intranet/htdocs/intranet-tmpl/prog/en/xslt/OAI2MARC21slim.xsl</span>
        </li>
        </li>
        <li>
            <label>Record type</label>
        </li>
    </ol>
</fieldset>

Lines 120-125 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (+2 lines)
120	<dt><a href="/cgi-bin/koha/admin/sms_providers.pl">SMS cellular providers</a></dt>	120	<dt><a href="/cgi-bin/koha/admin/sms_providers.pl">SMS cellular providers</a></dt>
121	<dd>Define a list of cellular providers for sending SMS messages via email.</dd>	121	<dd>Define a list of cellular providers for sending SMS messages via email.</dd>
122	[% END %]	122	[% END %]
		123	<dt><a href="/cgi-bin/koha/admin/saved_tasks.pl">Saved tasks</a></dt>
		124	<dd>Define tasks which may be run in the background</dd>
123	</dl>	125	</dl>
124	</div>	126	</div>
125	</div>	127	</div>




[% INCLUDE 'doc-head-open.inc' %]
<title>Koha &rsaquo; Administration &rsaquo; Saved tasks</title>
[% INCLUDE 'doc-head-close.inc' %]
[% INCLUDE 'calendar.inc' %]
<script type="text/javascript" src="[% interface %]/lib/jquery/plugins/jquery-ui-timepicker-addon.min.js"></script>
[% INCLUDE 'timepicker.inc' %]
[% IF ( op == "list" ) %]
    <link rel="stylesheet" type="text/css" href="[% interface %]/[% theme %]/css/datatables.css" />
    [% INCLUDE 'datatables.inc' %]
    <script type="text/javascript">
    //<![CDATA[
        $(document).ready(function() {
            $("#taskst").dataTable($.extend(true, {}, dataTablesDefaults, {
                "aoColumnDefs": [
                    { "aTargets": [3,4,5,6], "bSortable": false },
                ],
                "sPaginationType": "four_button"
            }));
        });
    //]]>
    </script>
[% ELSIF ( op == "edit" ) || ( op == "new" ) %]
    <script type="text/javascript">
    //<![CDATA[
        $(document).ready(function() {
            [%# Ideally, it would be nice to record the timezone here too, but currently we use MySQL's DATETIME field which doesn't store ISO 8601 timezone designators... %]
            $(".datetime_local").datetimepicker({
                dateFormat: "yy-mm-dd",
                timeFormat: "HH:mm:ss",
                hour: 0,
                minute: 0,
                second: 0,
                showSecond: 1,
            });
            $(".datetime_utc").datetimepicker({
                separator: "T",
                timeSuffix: 'Z',
                dateFormat: "yy-mm-dd",
                timeFormat: "HH:mm:ss",
                hour: 0,
                minute: 0,
                second: 0,
                showSecond: 1,
                // timezone doesn't work with the "Now" button in v1.4.3 although it appears to in v1.6.1
                // timezone: +000,
            });

        });
    //]]>
    </script>
    <style type="text/css">
        /* Override staff-global.css which hides second, millisecond, and microsecond sliders */
        .ui_tpicker_second {
            display: block;
        }
        .test-success {
            /* same color as .text-success in Bootstrap 2.2.2 */
            color:#468847;
        }
    </style>
[% END %]
</head>

<body id="admin_saved_tasks" class="admin">
[% INCLUDE 'header.inc' %]
[% INCLUDE 'cat-search.inc' %]
<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a> &rsaquo; Saved tasks</div>

<div id="doc3" class="yui-t2">

<div id="bd">
  <div id="yui-main">
    <div class="yui-b">
        [% IF ( op ) %]
            [% IF ( op == "new" ) || ( op == "edit" ) %]
                [%# If step is undefined, force it to be step one %]
                [% IF ( ! step ); step = "one"; END; %]



                [%# HEADING %]
                    [% IF ( op == "new" ) %]
                        <h1>New saved task</h1>
                    [% ELSIF ( op == "edit" ) %]
                        <h1>Modify saved task</h1>
                    [% END %]
                [%# /HEADING %]

                [%# TODO: Get this working properly... <div class="alert">Validation failed.</div> #]

                [%# FORM %]
                    <form action="/cgi-bin/koha/admin/[% filename %]" name="detail-form" method="post" id="saved-task-details" novalidate="novalidate">
                        [% IF ( op == "new" ) %]
                            <input type="hidden" name="op" value="create" />
                        [% ELSIF ( op == "edit" ) %]
                            <input type="hidden" name="op" value="update" />
                            <input type="hidden" name="saved_task_id" value="[% saved_task.task_id %]" />
                        [% END %]
                        <input type="hidden" name="step" value="[% step %]" />
                        <fieldset class="rows">
                            <ol>
                                [% IF ( op == "edit") && ( step == "one" ) && (! task_type_is_valid ) %]
                                <li>
                                    <label for="invalid_task_type">Current invalid task type:</label>
                                    <input id="invalid_task_type" type="text" disabled="disabled" value="[% saved_task.task_type %]" size="60" />
                                    <span class="error">Sorry! This task type is invalid. Please choose a new one from the following list.</span>
                                <li>
                                [% END %]
                                <li>
                                    <label for="task_type">Task type: </label>
                                    [% IF ( step == "one" ) %]
                                        [% IF ( available_plugins ) %]
                                        <select id="task_type" name="task_type">
                                            [% IF ( op == "new") %]
                                                [% FOREACH plugin IN available_plugins %]
                                                    <option value="[% plugin %]">[% plugin %]</option>
                                                [% END %]
                                            [% ELSIF ( op == "edit" ) %]
                                                [% FOREACH plugin IN available_plugins %]
                                                    [% IF ( saved_task.task_type == plugin ) %]
                                                        <option selected="selected" value="[% plugin %]">[% plugin %]</option>
                                                    [% ELSE %]
                                                        <option value="[% plugin %]">[% plugin %]</option>
                                                    [% END %]
                                                [% END %]
                                            [% END %]
                                        </select>
                                        [% END %]

                                    [% ELSIF ( step == "two" ) %]
                                        <input type="text" disabled="disabled" value="[% task_type %]" size="60" />
                                        <input type="hidden" name="task_type" value="[% task_type %]" />
                                    [% END %]
                                </li>
                            </ol>
                        </fieldset>

                        [% IF ( step == "one" ) %]
                            <fieldset class="action">
                                <input type="submit" value="Next">
                                <a class="cancel" href="/cgi-bin/koha/admin/[% filename %]">Cancel</a>
                            </fieldset>
                        [% ELSIF ( step == "two" ) %]
                            <fieldset class="rows">
                                <legend>Task:</legend>
                                <ol>
                                    <li>
                                        <label for="start_time">Start time: </label>
                                        <input type="text" id="start_time" class="datetime_local" name="start_time" value="[% saved_task.start_time %]" size="30" />
                                        <span class="help">This value will be treated as local server time, and times in the past will start immediately.</span>
                                    </li>
                                    <li>
                                        <label for="repeat_interval">Repeat interval: </label>
                                        <input type="text" id="repeat_interval" name="repeat_interval" value="[% saved_task.repeat_interval %]" size="4" />
                                        <span class="help">seconds</span>
                                        [% IF (errors.repeat_interval.not_numeric) %]<span class="error">[The repeat interval must be a purely numeric value.]</span>[% END %]
                                    </li>
                                </ol>
                            </fieldset>
                            [%# Try to include the template, but if it fails, fallback to a regular text view %]
                            [% TRY %]
                                [% INCLUDE $task_template %]
                            [% CATCH %]
                            <fieldset class="rows">
                                <legend>Plugin parameters:</legend>
                                <ol>
                                    <li>
                                        <label for="params">Params: </label>
                                        <textarea id="params" name="params" cols="60" rows="20">[% saved_task.params %]</textarea>
                                    </li>
                                </ol>
                            </fieldset>
                            [% END %]
                            <fieldset class="action">
                                <input type="submit" value="Save">
                                <a class="cancel" href="/cgi-bin/koha/admin/[% filename %]">Cancel</a>
                            </fieldset>
                        [% END %]
                    </form>
                [%# /FORM %]
            [% END #/edit or new %]


            [% IF ( op == "list" ) %]
                <div id="toolbar" class="btn-toolbar">
                    <a id="newserver" class="btn btn-small" href="/cgi-bin/koha/admin/[% filename %]?op=new"><i class="fa fa-plus"></i> New saved task</a>
                </div>
                <h1>Saved tasks</h1>
                [% IF ( saved_response ) %]
                    [% IF ( saved_response == 'delete_success' ) %]
                        <div class="alert">Deletion successful.</div>
                    [% ELSIF ( saved_response == 'delete_failure' ) %]
                        <div class="alert">Deletion failed.</div>
                    [% END %]
                [% END %]
                [% IF ( sent_response ) %]
                    [% IF ( sent_response == 'icarus_offline' ) %]
                        <div class="alert">Send failed. Icarus is currently offline.</div>
                    [% END %]
                [% END %]
                <table id="taskst">
                    <thead>
                        <tr>
                            <th>Start time</th>
                            <th>Repeat interval</th>
                            <th>Task type</th>
                            <th>Params</th>
                            <th></th>
                            <th></th>
                            <th></th>
                        </tr>
                    </thead>
                    <tbody>
                    [% FOREACH saved_task IN saved_tasks %]
                        <tr>
                            <td>[% IF ( saved_task.start_time ) != "0000-00-00 00:00:00"; saved_task.start_time; END; %]</td>
                            <td>[% saved_task.repeat_interval %]</td>
                            <td>[% saved_task.task_type %]</td>
                            <td>
                                <ul>
                                [% FOREACH pair IN saved_task.params_as_perl.pairs %]
                                   <li>[% pair.key %] => [% pair.value %]</li>
                                [% END %]
                                </ul>
                            </td>
                            <td><a href="/cgi-bin/koha/admin/[% filename %]?op=edit&saved_task_id=[% saved_task.task_id %]">Edit</a></td>
                            <td><a href="/cgi-bin/koha/admin/[% filename %]?op=send&saved_task_id=[% saved_task.task_id %]">Send to Icarus</a></td>
                            <td><a href="/cgi-bin/koha/admin/[% filename %]?op=delete&saved_task_id=[% saved_task.task_id %]">Delete</a></td>
                        </tr>
                    [% END %]
                    </tbody>
                </table>
                <div id="daemon_controls">
                    <h1>Icarus dashboard</h1>
                    <table>
                    <tr>
                        <th>Status</th>
                        <th></th>
                        <th></th>
                    </tr>
                    <tr>
                        <td>

                        [% IF ( daemon_status == 'No such file or directory' ) #Socket doesn't exist at all %]
                            <span id="icarus_status">Unable to contact</span>
                        [% ELSIF ( daemon_status == 'Permission denied' ) #Apache doesn't have permission to write to socket %]
                            <span id="icarus_status">Permission denied</span>
                        [% ELSIF ( daemon_status == 'Connection refused' ) #Socket exists, but server is down %]
                            <span id="icarus_status">Connection refused</span>
                        [% ELSIF ( daemon_status == 'Start failed' ) %]
                            <span id="icarus_status">Start failed</span>
                        [% ELSIF ( daemon_status == 'online' ) %]
                            <span id="icarus_status">Online</span>
                        [% ELSIF ( daemon_status == 'shutting down' ) %]
                            <span id="icarus_status">Shutting down</span>
                        [% ELSE %]
                            <span id="icarus_status">[% daemon_status %]</span>
                        [% END %]
                        </td>
                        [%# TODO: Also provide controls for starting/restarting Icarus? %]
                        <td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=start_server">Start Icarus</a></td>
                        <td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=shutdown_server">Shutdown Icarus</a></td>
                    </tr>
                    </table>
                </div>
                <div id="tasks">
                    <h1>Active Icarus tasks</h1>
                    [% IF ( task_response ) %]
                        [% IF ( task_response.action == 'error' ) %]
                            [% IF ( task_response.error_message ) %]
                                [% IF ( task_response.error_message == 'No such process' ) %]
                                    <div class="alert">Task [% task_response.task_id %] does not exist.</div>
                                [% END %]
                            [% END %]
                        [% ELSIF ( task_response.action == 'pending' ) %]
                            <div class="alert">Initialising task [% task_response.task_id %].</div>
                        [% ELSIF ( task_response.action == 'already pending' ) %]
                            <div class="alert">Already initialised task [% task_response.task_id %].</div>
                        [% ELSIF ( task_response.action == 'already started' ) %]
                            <div class="alert">Already started task [% task_response.task_id %].</div>
                        [% ELSIF ( task_response.action == 'removed' ) %]
                            <div class="alert">Removing task [% task_response.task_id %].</div>
                        [% END %]
                    [% END %]
                    [% IF ( tasks ) %]
                        <table>
                            <thead>
                                <tr>
                                    <th>Task id</th>
                                    <th>Status</th>
                                    <th>Next start time (local server time)</th>
                                    <th>Repeat interval</th>
                                    <th>Task type</th>
                                    <th>Params</th>
                                    <th></th>
                                    <th></th>
                                </tr>
                            </thead>
                            <tbody>
                            [% FOREACH task IN tasks %]
                                <tr>
                                    <td>[% task.task_id %]</td>
                                    <td>
                                        [% SWITCH task.task.status %]
                                        [% CASE 'new' %]
                                        <span>New</span>
                                        [% CASE 'pending' %]
                                        <span>Pending</span>
                                        [% CASE 'started' %]
                                        <span>Started</span>
                                        [% CASE 'stopping' %]
                                        <span>Stopping</span>
                                        [% CASE 'failed' %]
                                        <span>Failed</span>
                                        [% CASE %]
                                        <span>[% task.task.status %]</span>
                                        [% END %]
                                    </td>
                                    <td>[% task.task.start %]</td>
                                    <td>[% task.task.repeat_interval %]</td>
                                    <td>[% task.task.type %]</td>
                                    <td>
                                        <ul>
                                        [% FOREACH pair IN task.task.params.pairs %]
                                           <li>[% pair.key %] => [% pair.value %]</li>
                                        [% END %]
                                        </ul>
                                    </td>
                                    <td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=start&server_task_id=[% task.task_id %]">Start</a></td>
                                    <td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=remove&server_task_id=[% task.task_id %]">Remove</a></td>
                                </tr>
                            [% END %]
                            </tbody>
                        </table>
                    [% END %]
                </div>
            [% END #/list %]
        [% END #/op %]
    </div>
  </div>
  <div class="yui-b">
    [% INCLUDE 'admin-menu.inc' %]
  </div>
</div>
[% INCLUDE 'intranet-bottom.inc' %]




#!/usr/bin/perl

#######################################################################

use Modern::Perl;
use POSIX; #For daemonizing
use Fcntl qw(:flock); #For pidfile
use Getopt::Long;
use Pod::Usage;

#Make the STDOUT filehandle hot, so that you can use shell re-direction. Otherwise, you'll suffer from buffering.
STDOUT->autoflush(1);
#Note that STDERR, by default, is already hot.

#######################################################################
#FIXME: Debugging signals
=pod
BEGIN {
    package POE::Kernel;
    use constant TRACE_SIGNALS => 1;
    use constant ASSERT_USAGE => 1;
    use constant ASSERT_DATA => 1;
}
=cut


use POE;
use JSON; #For Listener messages
use XML::LibXML; #For configuration files

use Koha::Icarus::Listener;

#######################################################################

my ($filename,$daemon,$log,$help);
my $verbosity = 1;
GetOptions (
    "f|file|filename=s"     => \$filename, #/kohawebs/dev/dcook/koha-dev/etc/koha-conf.xml
    "l|log=s"               => \$log,
    "d|daemon"              => \$daemon,
    "v=i"                   => \$verbosity,
    "h|?"                   => \$help,
) or pod2usage(2);
pod2usage(1) if $help;


if ( ! $filename || ! -f $filename ){
    warn "Failed to start.\n";
    if ( ! $filename ){
        warn("You must provide a valid configuration file using the -f switch.\n");
        pod2usage(1);
    }
    if ( ! -f $filename ){
        die(qq{"$filename" is not a file.\n});
    }
}

#Declare the variable with file scope so the flock stays for the duration of the process's life
my $pid_filehandle;

#Read configuration file
my $config = read_config_file($filename);

my $SOCK_PATH = $config->{socket} || '';
my $pid_file = $config->{pidfile} || '';
my $max_tasks = $config->{max_tasks};

#Overwrite configuration file with command line options
if ($log){
    $config->{log} = $log;
}

#Test file permissions...
my @warnings = ();
foreach my $file_to_check ($pid_file, $config->{log}){
    local (*TMP); 
    if ($file_to_check){
        utime(undef, undef, $file_to_check) || open(TMP, ">>$file_to_check") || push(@warnings,"couldn't touch $file_to_check: $!");
    }
}
if (@warnings){
    foreach my $warning (@warnings){
        warn $warning;
    }
    exit 1;
}

#Go into daemon mode, if user has included flag
if ($daemon){
    daemonize();
}

if ($pid_file){
    #NOTE: The filehandle needs to have file scope, so that the flock is preserved.
    $pid_filehandle = make_pid_file($pid_file);
}

#FIXME: Do we want to log to file only in daemon mode? $config->{log} should be populated by either the config file or the l|log GetOpt...
if ($daemon && $config->{log}){
    log_to_file($config->{log});
}


#FIXME: 1) In daemon mode, SIGUSR1 or SIGHUP for reloading/restarting?
#######################################################################

#Creates Icarus Listener
Koha::Icarus::Listener->spawn({
    Socket => $SOCK_PATH,
    MaxTasks => $max_tasks,
    Verbosity => $verbosity,
});

POE::Kernel->run();

exit;

sub read_config_file {
    my $filename = shift;
    my $config = {};
    if ( -e $filename ){
        eval {
            my $doc = XML::LibXML->load_xml(location => $filename);
            if ($doc){
                my $root = $doc->documentElement;
                my $icarus = $root->find('icarus')->shift;
                if ($icarus){
                    #Get all child nodes for the 'icarus' element
                    my @childnodes = $icarus->childNodes();
                    foreach my $node (@childnodes){
                        #Only consider nodes that are elements
                        if ($node->nodeType == XML_ELEMENT_NODE){
                            my $config_key = $node->nodeName;
                            my $first_child = $node->firstChild;
                            #Only consider nodes that have a text node as their first child
                            if ($first_child && $first_child->nodeType == XML_TEXT_NODE){
                                $config->{$config_key} = $first_child->nodeValue;
                            }
                        }
                    }
                }
            }
        };
    }
    return $config;
}

#######################################################################
#NOTE: On Debian, you can use the daemon binary to make a process into a daemon,
# the following subs are for systems that don't have the daemon binary.

sub daemonize {
    my $pid = fork;
    die "Couldn't fork: $!" unless defined($pid);
    if ($pid){
        exit; #Parent exit
    }
    POSIX::setsid() or die "Can't start a new session: $!";

    #Change to known system directory
    chdir('/');

    #Close inherited file handles, so that you can truly run in the background.
    open STDIN,  '<', '/dev/null';
    open STDOUT, '>', '/dev/null';
    open STDERR, '>&STDOUT';

    #FIXME: You should probabl rset file creation mask here as well...
}

sub log_to_file {
    my $logfile = shift;
    #Open a filehandle to append to a log file
    open(LOG, '>>', $logfile) or die "Unable to open a filehandle for $logfile: $!\n"; # --output
    LOG->autoflush(1); #Make filehandle hot (ie don't buffer)
    *STDOUT = *LOG; #Re-assign STDOUT to LOG | --stdout
    *STDERR = *STDOUT; #Re-assign STDERR to STDOUT | --stderr
}

sub make_pid_file {
    my $pidfile = shift;
    if ( ! -e $pidfile ){
        open(my $fh, '>', $pidfile) or die "Unable to write to $pidfile: $!\n";
        $fh->close;
    }

    open(my $pidfilehandle, '+<', $pidfile) or die "Unable to open a filehandle for $pidfile: $!\n";
    if (flock($pidfilehandle, LOCK_EX|LOCK_NB)){
        #Write pid to pidfile
        warn "Acquiring lock on $pidfile\n";
        #Now that we've acquired a lock, let's truncate the file
        truncate($pidfilehandle, 0);
        print $pidfilehandle $$."\n" or die $!;
        #Flush the filehandle so you're not suffering from buffering
        $pidfilehandle->flush();
        return $pidfilehandle;
    } else {
        my $number = <$pidfilehandle>;
        chomp($number);
        warn "$0 is already running with pid $number. Exiting.\n";
        exit(1);
    }
}

__END__

=head1 SYNOPSIS

icarusd.pl -f koha-conf.xml [--log icarus.log] [--daemon] [ -v 0-9 ] [-h]

=cut

Lines 149-154 $prefix = $ENV{'INSTALL_BASE'} \|\| "/usr"; Link Here

(-)a/rewrite-config.PL (+2 lines)
149	"__MEMCACHED_SERVERS__" => "",	149	"__MEMCACHED_SERVERS__" => "",
150	"__MEMCACHED_NAMESPACE__" => "",	150	"__MEMCACHED_NAMESPACE__" => "",
151	"__FONT_DIR__" => "/usr/share/fonts/truetype/ttf-dejavu",	151	"__FONT_DIR__" => "/usr/share/fonts/truetype/ttf-dejavu",
		152	"__ICARUS_RUN_DIR__" => "$prefix/var/run/icarus",
		153	"__ICARUS_MAX_TASKS__" => "30",
152	);	154	);
153		155
154	# Override configuration from the environment	156	# Override configuration from the environment

Line 0 Link Here

(-)a/skel/var/run/koha/icarus/README (-1 / +1 lines)
0	-	1	icarus dir

Return to bug 10662

Line 0 Link Here

(-)a/Koha/Icarus.pm (+177 lines)
		1	package Koha::Icarus;
		2
		3	# Copyright 2016 Prosentient Systems
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 3 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21	use IO::Socket::UNIX;
		22	use IO::Select;
		23	use URI;
		24	use JSON;
		25
		26	sub new {
		27	my ($class, $args) = @_;
		28	$args = {} unless defined $args;
		29	return bless ($args, $class);
		30	}
		31
		32	sub connected {
		33	my ($self) = @_;
		34	if ($self->{_connected}){
		35	return 1;
		36	}
		37	}
		38
		39	sub connect {
		40	my ($self) = @_;
		41	my $socket_uri = $self->{socket_uri};
		42	if ($socket_uri){
		43	my $uri = URI->new($socket_uri);
		44	if ($uri && $uri->scheme eq 'unix'){
		45	my $socket_path = $uri->path;
		46	my $socket = IO::Socket::UNIX->new(
		47	Type => IO::Socket::UNIX::SOCK_STREAM(),
		48	Peer => $socket_path,
		49	);
		50	if ($socket){
		51	my $socketio = new IO::Select();
		52	$socketio->add($socket);
		53	#FIXME: Should probably fix these return values...
		54	$self->{_socketio} = $socketio;
		55	$self->{_socket} = $socket;
		56	my $message = $self->_read();
		57	if ($message eq 'HELLO'){
		58	$self->{_connected} = 1;
		59	return 1;
		60	}
		61	}
		62	}
		63	}
		64	return 0;
65	}
66
67	sub add_task {
68	my ($self, $args) = @_;
69	my $task = $args->{task};
70	if ($task && %$task){
71	my $response = $self->command("add task", undef, $task);
72	if ($response){
73	return $response;
74	}
75	}
76	}
77
78	sub start_task {
79	my ($self, $args) = @_;
80	my $task_id = $args->{task_id};
81	if ($task_id){
82	my $response = $self->command("start task", $task_id);
83	if ($response){
84	return $response;
85	}
86	}
87	}
88
89	sub remove_task {
90	my ($self, $args) = @_;
91	my $task_id = $args->{task_id};
92	if ($task_id){
93	my $response = $self->command("remove task", $task_id);
94	if ($response){
95	return $response;
96	}
97	}
98	}
99
100	sub list_tasks {
101	my ($self) = @_;
102	my $response = $self->command("list tasks");
103	if ($response){
104	if (my $tasks = $response->{tasks}){
105	return $tasks;
106	}
107	}
108	}
109
110	sub shutdown {
111	my ($self) = @_;
112	my $response = $self->command("shutdown");
113	if ($response){
114	return $response;
115	}
116	}
117
118
119
120
121
122	sub command {
123	my ($self, $command, $task_id, $task) = @_;
124	my $serialized = $self->_serialize({ "command" => $command, "task_id" => $task_id, "task" => $task });
125	if ($serialized){
126	$self->_write({ serialized => $serialized });
127	my $json = $self->_read();
128	if ($json){
129	my $response = from_json($json);
130	if ($response){
131	return $response;
132	}
133	}
134	}
135	}
136
137	sub _serialize {
138	my ($self, $output) = @_;
139	my $serialized = to_json($output);
140	return $serialized;
141	}
142
143	sub _write {
144	my ($self, $args) = @_;
145	my $socket = $self->{_socket};
146	my $output = $args->{serialized};
147	if ($output){
148	if (my $socketio = $self->{_socketio}){
149	if (my @filehandles = $socketio->can_write(5)){
150	foreach my $filehandle (@filehandles){
151	#Localize output record separator as null
152	local $\ = "\x00";
153	print $socket $output;
154	}
155	}
156	}
157	}
158	}
159
160	sub _read {
161	my ($self) = @_;
162	if (my $socketio = $self->{_socketio}){
163	if (my @filehandles = $socketio->can_read(5)){
164	foreach my $filehandle (@filehandles){
165	#Localize input record separator as null
166	local $/ = "\x00";
167	my $message = <$filehandle>;
168	chomp($message) if $message;
169	return $message;
170	}
171	}
172	}
173	}
174
175
176
177	1;

Line 0 Link Here

(-)a/Koha/Icarus/Base.pm (+32 lines)
	1	package Koha::Icarus::Base;
	2
	3	use Modern::Perl;
	4	use DateTime;
	5
	6	use constant DEBUG => 9;
	7	use constant SILENT => 0;
	8
	9	sub new {
	10	my ($class, $args) = @_;
	11	$args = {} unless defined $args;
	12	return bless ($args, $class);
	13	}
	14
	15	sub debug {
	16	my ($self,$message) = @_;
	17	if ($self->{Verbosity} == DEBUG){
	18	$self->log($message);
	19	}
	20	}
	21
	22	sub log {
	23	my ($self,$message) = @_;
	24	my $id = $self->{_id};
	25	my $component = $self->{_component} // "component";
	26	if ( ($self->{Verbosity}) && ($self->{Verbosity} > SILENT) ){
	27	my $now = DateTime->now(time_zone => "local");
	28	say "[$now] [$component $id] $message";
	29	}
	30	}
	31
	32	1;

Line 0 Link Here

(-)a/Koha/Icarus/Listener.pm (+330 lines)
		1	package Koha::Icarus::Listener;
		2
		3	use Modern::Perl;
		4	use parent 'Koha::Icarus::Base';
		5
		6	use POE qw(Wheel::ReadWrite Wheel::SocketFactory Wheel::Run);
		7	use IO::Socket qw(AF_UNIX);
		8	use URI;
		9	use Koha::Icarus::Task;
		10	use JSON; #For "on_client_input"
		11
		12	my $null_filter = POE::Filter::Line->new(
		13	Literal => chr(0),
		14	);
		15
		16	sub new {
		17	my ($class, $args) = @_;
		18	$args = {} unless defined $args;
		19	$args->{_component} = "server";
		20	$args->{_id} = "undefined";
		21	return bless ($args, $class);
		22	}
		23
		24	#NOTE: "spawn" inspired by http://poe.perl.org/?POE_Cookbook/Object_Methods
		25	sub spawn {
		26	my ($class, $args) = @_;
		27	my $self = $class->new($args);
		28	POE::Session->create(
		29	object_states => [
		30	$self => {
		31	_start => "on_server_start",
		32	shutdown => "shutdown",
		33	set_verbosity => "set_verbosity",
		34	_child => "on_task_event",
		35	got_list_tasks => "on_list_tasks",
		36	graceful_shutdown => "graceful_shutdown",
		37	got_client_accept => "on_client_accept",
		38	got_client_error => "on_client_error",
		39	got_server_error => "on_server_error",
		40	got_add_task => "on_add_task",
		41	got_client_input => "on_client_input",
		42	},
		43	],
		44	);
		45	}
		46
		47	#Methods for POE::Session
		48
		49	sub on_server_start {
		50	my ($self, $kernel,$heap,$session) = @_[OBJECT, KERNEL,HEAP,SESSION];
		51	my $server_id = $session->ID;
		52	$self->{_id} = $server_id; #Set internal id for logging purposes
		53
		54
		55	my $bind_address_uri = $self->{Socket};
		56	my $max_tasks = $self->{MaxTasks};
		57
		58	$kernel->sig(INT => "graceful_shutdown");
		59	$kernel->sig(TERM => "graceful_shutdown");
		60
		61	$heap->{max_tasks} = $max_tasks // 25; #Default maximum of 25 unless otherwise specified
		62
		63	$self->log("Maximum number of tasks allowed: $heap->{max_tasks}");
		64	$self->log("Starting server...");
65
66	my %server_params = (
67	SuccessEvent => "got_client_accept",
68	FailureEvent => "got_server_error",
69	);
70
71	#TODO: At this time, only "unix" sockets are supported. In future, perhaps TCP/IP sockets could also be supported.
72	my $uri = URI->new($bind_address_uri);
73	my $scheme = $uri->scheme;
74
75	if ($scheme eq 'unix'){
76	my $bind_address = $uri->path;
77	$server_params{SocketDomain} = AF_UNIX;
78	$server_params{BindAddress} = $bind_address;
79	#When starting a unix socket server, you need to remove any existing references to that socket file.
80	if ($bind_address && (-e $bind_address) ){
81	$self->debug("Unlinking $bind_address");
82	unlink $bind_address or warn "Could not unlink $bind_address: $!";
83	}
84	}
85
86	$heap->{server} = POE::Wheel::SocketFactory->new(%server_params);
87
88	if ($scheme eq 'unix'){
89	#FIXME/DEBUGGING: This is a way to force a permission denied error...
90	#chmod 0755, $uri->path;
91	#Make the socket writeable to other users like Apache
92	chmod 0666, $uri->path;
93	}
94
95	}
96
97	sub shutdown {
98	my ($self,$heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];
99
100	if ($heap->{server}){
101	$self->log("Shutting down server...");
102	#Delete the server, so that you can't get any new connections
103	delete $heap->{server} if $heap->{server};
104	}
105
106	if ($heap->{client}){
107	$self->log("Shutting down any remaining clients...");
108	#Delete the clients, so that you bring down the existing connections
109	delete $heap->{client}; #http://www.perlmonks.org/?node_id=176971
110	}
111	}
112
113	sub on_task_event {
114	my ($self, $kernel, $heap,$session) = @_[OBJECT,KERNEL, HEAP,SESSION];
115	my ($action,$child_session,$task) = @_[ARG0,ARG1,ARG2];
116
117	my $child_id = $child_session->ID;
118
119	$self->debug("$action child $child_id");
120
121
122	if ($action eq 'create'){
123	#NOTE: The $task variable is returned by the child POE session's _start event
124	my $task_id = $child_session->ID;
125	$heap->{tasks}->{$task_id}->{task} = $task;
126
127	} elsif ($action eq 'lose'){
128	my $task_id = $child_session->ID;
129	delete $heap->{tasks}->{$task_id};
130	}
131	}
132
133	#TODO: Put this in a parent class?
134	sub set_verbosity {
135	my ($self,$session,$kernel,$new_verbosity) = @_[OBJECT,SESSION,KERNEL,ARG0];
136	if (defined $new_verbosity){
137	$self->{Verbosity} = $new_verbosity;
138	}
139	}
140
141	sub on_list_tasks {
142	my ($self, $kernel, $heap,$session) = @_[OBJECT, KERNEL, HEAP,SESSION];
143
144	#DEBUG: You can access the POE::Kernel's sessions with "$POE::Kernel::poe_kernel->[POE::Kernel::KR_SESSIONS]".
145	#While it's black magic you shouldn't touch, it can be helpful when debugging.
146
147	my @tasks = ();
148	foreach my $task_id (keys %{$heap->{tasks}} ){
149	push(@tasks,{ task_id => $task_id, task => $heap->{tasks}->{$task_id}->{task} });
150	}
151	return \@tasks;
152	}
153
154	sub graceful_shutdown {
155	my ($self, $heap,$session,$kernel,$signal) = @_[OBJECT, HEAP,SESSION,KERNEL,ARG0];
156
157	#Tell the kernel that you're handling the signal sent to this session
158	$kernel->sig_handled();
159	$kernel->sig($signal);
160
161	my $tasks = $kernel->call($session,"got_list_tasks");
162
163
164	if ( $heap->{tasks} && %{$heap->{tasks}} ){
165	$self->log("Waiting for tasks to finish...");
166	foreach my $task_id (keys %{$heap->{tasks}}){
167	$self->log("Task $task_id still exists...");
168	$kernel->post($task_id,"got_task_stop");
169	}
170	} else {
171	$self->log("All tasks have finished");
172	$kernel->yield("shutdown");
173	return;
174	}
175
176	$self->log("Attempting graceful shutdown in 1 second...");
177	#NOTE: Basically, we just try another graceful shutdown on the next tick.
178	$kernel->delay("graceful_shutdown" => 1);
179	}
180
181	#Accept client connection to listener
182	sub on_client_accept {
183	my ($self, $client_socket, $server_wheel_id, $heap, $session) = @_[OBJECT, ARG0, ARG3, HEAP,SESSION];
184
185	my $client_wheel = POE::Wheel::ReadWrite->new(
186	Handle => $client_socket,
187	InputEvent => "got_client_input",
188	ErrorEvent => "got_client_error",
189	InputFilter => $null_filter,
190	OutputFilter => $null_filter,
191	);
192
193	$client_wheel->put("HELLO");
194	$heap->{client}->{ $client_wheel->ID() } = $client_wheel;
195
196	$self->debug("Connection ".$client_wheel->ID()." started.");
197
198	}
199
200	#Handle server error - shutdown server
201	sub on_server_error {
202	my ($self, $operation, $errnum, $errstr, $heap, $session) = @_[OBJECT, ARG0, ARG1, ARG2,HEAP, SESSION];
203	$self->log("Server $operation error $errnum: $errstr");
204	delete $heap->{server};
205	}
206
207	#Handle client error - including disconnect
208	sub on_client_error {
209	my ($self, $wheel_id,$heap,$session) = @_[OBJECT, ARG3,HEAP,SESSION];
210
211	$self->debug("Connection $wheel_id failed or ended.");
212
213	delete $heap->{client}->{$wheel_id};
214
215	}
216
217	sub on_add_task {
218	my ($self, $message, $kernel, $heap, $session) = @_[OBJECT, ARG0, KERNEL, HEAP,SESSION];
219
220	#Fetch a list of all tasks
221	my @task_keys = keys %{$heap->{tasks}};
222
223	#If the number in the list is less than the max, add a new task
224	#else die.
225	if (scalar @task_keys < $heap->{max_tasks}){
226	my $server_id = $session->ID;
227	my $task_session = Koha::Icarus::Task->spawn({ message => $message, server_id => $server_id, Verbosity => $self->{Verbosity}, });
228	return $task_session->ID;
229	} else {
230	#This die should be caught by the event caller...
231	die "Maximum number of tasks already reached.\n";
232	}
233	}
234
235	sub on_client_input {
236	my ($self, $input, $wheel_id, $session, $kernel, $heap) = @_[OBJECT, ARG0, ARG1, SESSION, KERNEL, HEAP];
237
238	#Store server id more explicitly
239	my $server_id = $session->ID;
240
241	#Server listener has received input from client
242	my $client = $heap->{client}->{$wheel_id};
243
244	#Parse input from client
245	my $message = from_json($input);
246
247	if ( ref $message eq 'HASH' ){
248	#Read "command" from client
249	if (my $command = $message->{command}){
250	$self->log("Message received with command \"$command\".");
251	if ($command eq 'add task'){
252	my $output = {};
253
254	#Create a task session
255	eval {
256	#NOTE: The server automatically keeps track of its child tasks
257	my $task_id = $kernel->call($server_id,"got_add_task",$message);
258
259	$output->{action} = "added";
260	$output->{task_id} = $task_id;
261	};
262	if ($@){
263	$self->debug("$@");
264	chomp($@);
265	$output->{action} = "error";
266	$output->{error_message} = $@;
267	}
268	my $server_output = to_json($output);
269	$client->put($server_output);
270	return;
271
272	} elsif ( ($command eq 'remove task') \|\| ($command eq 'start task' ) ){
273
274	my $task_id = $message->{task_id};
275
276	my $output = {
277	task_id => $task_id,
278	};
279
280	if ($command eq 'remove task'){
281	$kernel->call($task_id,"got_task_stop");
282	$output->{action} = "removed";
283	} elsif ($command eq 'start task'){
284	my $response = $kernel->call($task_id, "on_task_init");
285	$output->{action} = $response;
286	}
287
288	if ($!){
289	$output->{action} = "error";
290	$output->{error_message} = $!;
291	}
292
293	#FIXME: What do we actually want to send back to the client?
294	my $server_output = to_json($output);
295	$client->put($server_output);
296	return;
297
298	} elsif ($command eq 'list tasks'){
299
300	#Get tasks from listener (ie self)
301	my $tasks = $kernel->call($server_id, "got_list_tasks");
302
303	#Prepare output for client
304	my $server_output = to_json({tasks => $tasks}, {pretty => 1});
305
306	#Send output to client
307	$client->put($server_output);
308	return;
309
310	} elsif ($command eq 'shutdown'){
311	$kernel->post($server_id, "graceful_shutdown");
312	my $server_output = to_json({action => 'shutting down'});
313	$client->put($server_output);
314	return;
315	} else {
316	$self->log("The message contained an invalid command!");
317	$client->put("Sorry! That is an invalid command!");
318	return;
319	}
320	} else {
321	$self->log("The message was missing a command!");
322	}
323	} else {
324	$self->log("The message was malformed!");
325	}
326	$client->put("Sorry! That is an invalid message!");
327	return;
328	}
329
330	1;

Line 0 Link Here

(-)a/Koha/Icarus/Task.pm (+324 lines)
		1	package Koha::Icarus::Task;
		2
		3	use Modern::Perl;
		4	use parent 'Koha::Icarus::Base';
		5
		6	use POE qw(Wheel::Run);
		7	use DateTime;
		8	use DateTime::Format::Strptime;
		9	use JSON;
		10	use Module::Load::Conditional qw/can_load/;
		11
		12	my $datetime_pattern = DateTime::Format::Strptime->new(
		13	pattern => '%F %T',
		14	time_zone => 'local',
		15	);
		16	my $epoch_pattern = DateTime::Format::Strptime->new(
		17	pattern => '%s',
		18	);
		19
		20	sub new {
		21	my ($class, $args) = @_;
		22	$args = {} unless defined $args;
		23	$args->{_component} = "task";
		24	$args->{_id} = "undefined";
		25	return bless ($args, $class);
		26	}
		27
		28	#NOTE: "spawn" inspired by http://poe.perl.org/?POE_Cookbook/Object_Methods
		29	sub spawn {
		30	my ($class, $args) = @_;
		31	my $self = $class->new($args);
		32	my $task_session = POE::Session->create(
		33	object_states => [
		34	$self => {
		35	_start => "on_task_create",
		36	"got_child_stdout" => "on_child_stdout",
		37	"got_child_stderr" => "on_child_stderr",
		38	"got_child_close" => "on_child_close",
		39	"got_child_signal" => "on_child_signal",
		40	"got_terminal_signal" => "on_terminal_signal",
		41	"child_process_success" => "child_process_success",
		42	"child_process_failure" => "child_process_failure",
		43	"got_task_stop" => "on_task_stop",
		44	"on_task_init" => "on_task_init",
		45	"on_task_start" => "on_task_start",
		46	},
		47	],
		48	);
		49	return $task_session;
		50	}
		51
		52	sub on_task_create {
		53	my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];
		54
		55	#Trap terminal signals so that the task can stop gracefully.
		56	$kernel->sig(INT => "got_terminal_signal");
		57	$kernel->sig(TERM => "got_terminal_signal");
		58
		59	my $task_id = $session->ID;
		60	if ($task_id){
		61	#Tell the kernel that this task is waiting for an external action (ie keepalive counter)
		62	$kernel->refcount_increment($task_id,"waiting task");
		63	$self->{_id} = $task_id; #Set internal id for logging purposes
		64	}
65
66	my $server_id = $self->{server_id};
67	if ($server_id){
68	$heap->{server_id} = $server_id;
69	}
70
71	my $task = undef;
72	my $message = $self->{message};
73	if ($message){
74	$task = $message->{task};
75	if ($task){
76	$task->{status} = 'new';
77	$heap->{task} = $task;
78	}
79	}
80	return $task; #This return value is used by the parent POE session's _child handler
81	}
82
83	#This sub is just to start it now, or set it to start in the future... if the time is now or in the past, it starts now... if it's in the future, it starts in the future...
84	sub on_task_init {
85	my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];
86	my $response = 'pending';
87	my $task = $heap->{task};
88	my $status = $task->{status};
89	if ($status){
90	if ($status eq 'started'){
91	$response = 'already started';
92	} elsif ($status eq 'pending'){
93	$response = 'already pending';
94	} else {
95	$task->{status} = 'pending';
96
97	my $start = $task->{start};
98	my $start_message = $start;
99
100
101	my $dt;
102	if ( $dt = $datetime_pattern->parse_datetime($start) ){
103	#e.g. 2016-04-06 00:00:00
104	} elsif ( $dt = $epoch_pattern->parse_datetime($start) ){
105	#e.g. 1459837498 or apparently 0000-00-00 00:00:00
106	} else {
107	#If we don't match the datetime_pattern or epoch_pattern, then we start right now.
108	$dt = DateTime->now( time_zone => 'local', );
109	}
110	if ($dt){
111	$start = $dt->epoch;
112	$start_message = $dt;
113	}
114
115
116	$self->log("Start task at $start_message");
117	#NOTE: $start must be in UNIX epoch time (ie number of seconds that have elapsed since 00:00:00 UTC Thursday 1 January 1970)
118	$kernel->alarm("on_task_start",$start);
119	}
120	}
121	return $response;
122	}
123
124	sub on_task_start {
125	my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];
126	my $task = $heap->{task};
127	$task->{status} = 'started';
128
129	if (my $repeat_interval = $task->{repeat_interval}){
130	#NOTE: Reset the start time with a human readable timestamp
131	my $dt = DateTime->now( time_zone => 'local', );
132	$dt->add( seconds => $repeat_interval );
133	$task->{start} = $dt->strftime("%F %T");
134	}
135	#FIXME: You need to impose child process limits here! How many child processes are allowed to be running at any given time? Well, you can only have one child process per task...
136	#so it's really more of a limit on the number of tasks... you probably need to have an internal task queue... that's easy enough though.
137	my $child = POE::Wheel::Run->new(
138	ProgramArgs => [ $task, ],
139	Program => sub {
140	my ($task) = @_;
141
142	#Perform some last minute POE calls before running the task module plugin
143	my $session = $poe_kernel->get_active_session();
144	if ($session){
145	my $heap = $session->get_heap();
146	$poe_kernel->call($heap->{server_id},"set_verbosity",0); #This turns off the server logging in this forked process, so the following call() doesn't mess up our logs
147	$poe_kernel->call($heap->{server_id},"shutdown"); #Shutdown the socket listener on the child process, so there's zero chance of writing to or reading from the socket in the child process
148	}
149
150	#NOTE: I don't know if this really needs to be run, but it shouldn't hurt.
151	$poe_kernel->stop();
152
153	#Try to load the task type module.
154	my $task_type = $task->{type};
155	if ( can_load ( modules => { $task_type => undef, }, ) ){
156	#Create the object
157	my $task_object = $task_type->new({task => $task, Verbosity => $self->{Verbosity}, });
158	if ($task_object){
159	#Synchronous action: run the task module
160	$task_object->run;
161	}
162	} else {
163	die "Couldn't load module $task_type: $Module::Load::Conditional::ERROR"
164	}
165	},
166	StdoutEvent => "got_child_stdout",
167	StderrEvent => "got_child_stderr",
168	CloseEvent => "got_child_close",
169	NoSetPgrp => 1, #Keep child processes in same group as parent. This is especially useful when using Ctrl+C to kill the whole group.
170	);
171
172	$kernel->sig_child($child->PID, "got_child_signal");
173	# Wheel events include the wheel's ID.
174	$_[HEAP]{children_by_wid}{$child->ID} = $child;
175	# Signal events include the process ID.
176	$_[HEAP]{children_by_pid}{$child->PID} = $child;
177
178	$self->debug("child pid ".$child->PID." started as wheel ".$child->ID);
179	}
180
181	sub on_task_stop {
182	my ($self, $session, $kernel, $heap) = @_[OBJECT, SESSION, KERNEL, HEAP];
183	my $task = $heap->{task};
184	$task->{status} = 'stopping';
185	my $task_id = $session->ID;
186	my $server_id = $heap->{server_id};
187
188	if ($heap->{stopping}){
189	$self->debug("Task is already in the process of stopping...");
190
191	} else {
192
193	$self->log("Trying to stop task.");
194
195
196	#Mark this task as stopping
197	$heap->{stopping} = 1;
198
199	#Stop the task from spawning new jobs
200	$kernel->alarm("on_task_start");
201
202	my $children_by_pid = $heap->{children_by_pid};
203	if ($children_by_pid && %$children_by_pid){
204
205	$self->debug("Child processes in progres...");
206	my $child_processes = $heap->{children_by_pid};
207	foreach my $child_pid (keys %$child_processes){
208	my $child = $child_processes->{$child_pid};
209	$self->debug("Telling child pid $child_pid to stop");
210	$child->put("quit");
211	#TODO: Perhaps it would be worthwhile having a kill switch too?
212	# my $rv = $child->kill("TERM");
213	}
214	}
215
216	$self->log("Removing task keepalive.");
217
218	$kernel->refcount_decrement($task_id,"waiting task");
219	}
220	}
221
222	sub on_terminal_signal {
223	my ($self, $signal,$session,$kernel) = @_[OBJECT, ARG0,SESSION,KERNEL];
224	$self->debug("Trapped SIGNAL: $signal.");
225	#Gracefully stop the task
226	$kernel->call($session, "got_task_stop");
227	}
228
229	sub child_process_failure {
230	my ($self, $heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];
231	my $task = $heap->{task};
232	$task->{status} = "failed";
233	}
234
235	sub child_process_success {
236	my ($self, $heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];
237	my $task = $heap->{task};
238	if (my $repeat_interval = $task->{repeat_interval}){
239	if ($heap->{stopping}){
240	$self->log("Will skip repeating the task, as task is stopping.");
241	} else {
242	$self->log("Will repeat the task");
243	$task->{status} = "restarting";
244	$kernel->yield("on_task_init");
245	}
246	} else {
247	$self->debug("I'm going to stop this task");
248	$kernel->yield("got_task_stop");
249	}
250	}
251
252	#############################################################
253	# #
254	# Methods for communicating with child processes #
255	# #
256	#############################################################
257	# Originally inspired by the POE::Wheel::Run perldoc example
258
259	# Wheel event, including the wheel's ID
260	sub on_child_stdout {
261	my ($self, $stdout_line, $wheel_id, $session) = @_[OBJECT, ARG0, ARG1, SESSION];
262	my $child = $_[HEAP]{children_by_wid}{$wheel_id};
263	#NOTE: Log everything child process sends to STDOUT
264	$self->log("[pid ".$child->PID."] STDOUT: $stdout_line");
265
266	#If the child outputs a line to STDOUT which starts with UPDATE_PARAMS=, we capture the data,
267	#and update the task params.
268	if ($stdout_line =~ /^UPDATE_PARAMS=(.*)$/){
269	my $json_string = $1;
270	my $json = from_json($json_string);
271	my $task = $_[HEAP]->{task};
272	my $params = $task->{params};
273	foreach my $key (%$json){
274	if (defined $params->{$key}){
275	#FIXME: Don't just overwrite? Only update differences?
276	$params->{$key} = $json->{$key};
277	}
278	}
279	$_[HEAP]->{task} = $task;
280	}
281	}
282
283	# Wheel event, including the wheel's ID.
284	sub on_child_stderr {
285	my ($self, $stderr_line, $wheel_id, $session) = @_[OBJECT, ARG0, ARG1,SESSION];
286	my $child = $_[HEAP]{children_by_wid}{$wheel_id};
287	#NOTE: Log everything child process sends to STDERR
288	$self->log("[pid ".$child->PID."] STDERR: $stderr_line");
289	}
290
291	# Wheel event, including the wheel's ID.
292	sub on_child_close {
293	my ($self, $wheel_id,$session,$kernel) = @_[OBJECT, ARG0,SESSION,KERNEL];
294
295	my $child = delete $_[HEAP]{children_by_wid}{$wheel_id};
296
297	# May have been reaped by on_child_signal().
298	unless (defined $child) {
299	$self->debug("[wid $wheel_id] closed all pipes.");
300	return;
301	}
302	$self->debug("[pid ".$child->PID."] closed all pipes.");
303	delete $_[HEAP]{children_by_pid}{$child->PID};
304	}
305
306	sub on_child_signal {
307	my ($self, $heap,$kernel,$pid,$exit_code,$session) = @_[OBJECT, HEAP,KERNEL,ARG1,ARG2,SESSION];
308
309	#If the child's exit code is 0, handle this successful exit status
310	if ($exit_code == 0){
311	$kernel->yield("child_process_success");
312	} else {
313	$kernel->yield("child_process_failure");
314	}
315	$self->debug("pid $pid exited with status $exit_code.");
316	my $child = delete $_[HEAP]{children_by_pid}{$pid};
317
318	# May have been reaped by on_child_close().
319	return unless defined $child;
320
321	delete $_[HEAP]{children_by_wid}{$child->ID};
322	}
323
324	1;

Line 0 Link Here

(-)a/Koha/Icarus/Task/Base.pm (+24 lines)
	1	package Koha::Icarus::Task::Base;
	2
	3	use Modern::Perl;
	4	use IO::Select;
	5
	6	sub new {
	7	my ($class, $args) = @_;
	8	$args = {} unless defined $args;
	9	return bless ($args, $class);
	10	}
	11
	12	sub listen_for_instruction {
	13	my ($self) = @_;
	14	my $select = $self->{_select} \|\|= IO::Select->new(\*STDIN);
	15	if (my @ready_FHs = $select->can_read(0) ){
	16	foreach my $FH (@ready_FHs){
	17	my $line = $FH->getline();
	18	chomp($line);
	19	return $line;
	20	}
	21	}
	22	}
	23
	24	1;

Line 0 Link Here

(-)a/Koha/Icarus/Task/Download/OAIPMH/Biblio.pm (+321 lines)
		1	package Koha::Icarus::Task::Download::OAIPMH::Biblio;
		2
		3	use Modern::Perl;
		4	use parent 'Koha::Icarus::Task::Base';
		5
		6	use DateTime;
		7	use DateTime::Format::Strptime;
		8	use HTTP::OAI;
		9	use File::Path qw(make_path);
		10	use Digest::MD5;
		11	use JSON;
		12	use URI;
		13
		14	my $strp = DateTime::Format::Strptime->new(
		15	pattern => '%Y%m%dT%H%M%S.%NZ',
		16	);
		17
		18	my $oai_second_granularity = DateTime::Format::Strptime->new(
		19	pattern => '%Y-%m-%dT%H:%M:%SZ',
		20	);
		21
		22	my $oai_day_granularity = DateTime::Format::Strptime->new(
		23	pattern => '%Y-%m-%d',
		24	);
		25
		26	sub validate_parameter_names {
		27
		28	}
		29	sub validate_repeat_interval {
		30	my ($self,$repeat_interval) = @_;
		31	if (defined $repeat_interval && $repeat_interval =~ /^\d+$/){
		32	return undef;
		33	}
		34	$self->{invalid_data}++;
		35	return { not_numeric => 1, };
		36	}
		37
		38	sub validate_url {
		39	my ($self,$url) = @_;
		40	my $response = {};
		41	if (my $url_obj = URI->new($url)){
		42	if ($url_obj->scheme ne "http"){
		43	$response->{not_http} = 1;
		44	$self->{invalid_data}++;
		45	}
		46	if ( ! $url_obj->path){
		47	$response->{no_path} = 1;
		48	$self->{invalid_data}++;
		49	}
		50	} else {
		51	$response->{not_a_url} = 1;
		52	$self->{invalid_data}++;
		53	}
		54
		55	return $response;
		56	}
		57
		58	sub validate {
		59	my ($self, $args) = @_;
		60	#Reset the invalid data counter...
		61	$self->{invalid_data} = 0;
		62	my $errors = { };
		63	my $task = $self->{task};
		64	my $tests = $args->{tests};
65	if ($task){
66	if ($tests && $tests eq 'all'){
67	#warn "PARAMS = ".$task->{params};
68	}
69	}
70	my $params = $task->{params};
71
72	#validate_start_time
73	$errors->{"repeat_interval"} = $self->validate_repeat_interval($task->{repeat_interval});
74
75	$errors->{"url"} = $self->validate_url($params->{url});
76
77	#NOTE: You don't need to validate these 3 HTTP Basic Auth parameters
78	#validate_username
79	#validate_password
80	#validate_realm
81
82	#OAI-PMH parameters
83	#validate_verb
84	#validate_sets
85	#validate_marcxml
86	#validate_from
87	#validate_until
88
89	#Download parameters
90	#validate_queue
91
92	return $errors;
93	}
94
95	sub new {
96	my ($class, $args) = @_;
97	$args = {} unless defined $args;
98	$args->{invalid_data} = 0;
99	return bless ($args, $class);
100	}
101
102	sub validate_queue {
103	my ( $self ) = @_;
104	my $task = $self->{task};
105	if (my $queue = $task->{params}->{queue}){
106
107	my $queue_uri = URI->new($queue);
108	#TODO: In theory, you could even use a DBI DSN like DBI:mysql:database=koha;host=koha.db;port=3306.
109	#Then you could provide the table, username, and password in the params as well...
110
111	#NOTE: If the queue directory doesn't exist on the filesystem, we try to make it and change to it.
112	if ($queue_uri->scheme eq 'file'){
113	my $filepath = $queue_uri->file;
114	if ( ! -d $filepath ){
115	make_path($filepath,{ mode => 0755 });
116	}
117	if ( -d $filepath ){
118	chdir $filepath or die "$!";
119	}
120	}
121
122	}
123	}
124
125	sub run {
126	my ( $self ) = @_;
127	$self->validate_queue;
128
129	my $task = $self->{task};
130
131	#DEBUGGING/FIXME: Remove these lines
132	if ($self->{Verbosity} && $self->{Verbosity} == 9){
133	use Data::Dumper;
134	warn Dumper($task);
135	}
136
137	my $params = $task->{params};
138
139	my $now = DateTime->now(); #This is in UTC time, which is required by the OAI-PMH protocol.
140	if ( $oai_second_granularity->parse_datetime($params->{from}) ){
141	$now->set_formatter($oai_second_granularity);
142	} else {
143	$now->set_formatter($oai_day_granularity);
144	}
145
146	$params->{until} = "$now" if $task->{repeat_interval};
147
148	$self->{digester} = Digest::MD5->new();
149	$self->create_harvester;
150	my $sets = $self->prepare_sets;
151
152	#Send a OAI-PMH request for each set
153	foreach my $set (@{$sets}){
154	my $response = $self->send_request({set => $set});
155	$self->handle_response({ response => $response, set => $set,});
156	}
157
158	#FIXME: Do you want to update the task only when the task is finished, or
159	#also after each resumption?
160	#Update the task params in Icarus after the task is finished...
161	#TODO: This really does make it seem like you should be handling the repeat_interval within the child process rather than the parent...
162	if ($task->{repeat_interval}){
163	$params->{from} = "$now";
164	$params->{until} = "";
165	my $json_update = to_json($params);
166	say STDOUT "UPDATE_PARAMS=$json_update";
167	}
168
169	}
170
171	#FIXME: I wonder if it would be faster to send your own HTTP requests and not use HTTP::OAI...
172	sub send_request {
173	my ( $self, $args ) = @_;
174
175	#NOTE: This is plugin specific as the plugins define when they stop to listen for instructions...
176	#NOTE: Before sending a new request, check if Icarus has already asked us to quit.
177	my $instruction = $self->listen_for_instruction();
178	if ($instruction eq 'quit'){
179	warn "I was asked to quit!";
180	return;
181	}
182
183	my $set = $args->{set};
184	my $resumptionToken = $args->{resumptionToken};
185
186	my $response;
187	my $task_params = $self->{task}->{params};
188
189	my $harvester = $self->{harvester};
190	my $verb = $task_params->{verb};
191	if ($verb eq 'GetRecord'){
192	$response = $harvester->GetRecord(
193	metadataPrefix => $task_params->{metadataPrefix},
194	identifier => $task_params->{identifier},
195	);
196	} elsif ($verb eq 'ListRecords'){
197	$response = $harvester->ListRecords(
198	metadataPrefix => $task_params->{metadataPrefix},
199	from => $task_params->{from},
200	until => $task_params->{until},
201	set => $set,
202	resumptionToken => $resumptionToken,
203	);
204	}
205	return $response;
206	}
207
208	sub create_harvester {
209	my ( $self ) = @_;
210	my $task_params = $self->{task}->{params};
211
212	#FIXME: DEBUGGING
213	#use HTTP::OAI::Debug qw(+);
214
215	#Create HTTP::OAI::Harvester object
216	my $harvester = new HTTP::OAI::Harvester( baseURL => $task_params->{url} );
217	if ($harvester){
218	$harvester->timeout(5); #NOTE: the default timeout is 180
219	#Set HTTP Basic Authentication Credentials
220	my $uri = URI->new($task_params->{url});
221	my $host = $uri->host;
222	my $port = $uri->port;
223	$harvester->credentials($host.":".$port, $task_params->{realm}, $task_params->{username}, $task_params->{password});
224	}
225	$self->{harvester} = $harvester;
226	}
227
228	sub prepare_sets {
229	my ( $self ) = @_;
230	my $task_params = $self->{task}->{params};
231	my @sets = ();
232	if ($task_params->{sets}){
233	@sets = split(/\\|/, $task_params->{sets});
234	}
235	#If no sets are defined, create a null element to force the foreach loop to run once
236	if (!@sets){
237	push(@sets,undef)
238	}
239	return \@sets;
240	}
241
242	sub handle_response {
243	my ( $self, $args ) = @_;
244	my $params = $self->{task}->{params};
245	my $response = $args->{response};
246	my $set = $args->{set};
247	if ($response){
248	#NOTE: We have options at this point
249	#Option 1: Use $response->toDOM() to handle the XML response as a single document
250	#Option 2: Use $response->next() to handle each record individually. You would need to create a new document using $rec->header->dom() and $rec->metadata->dom() anyway.
251
252	#NOTE: I wonder which option would be the fastest. For now, we're going with Option 1:
253	my $dom = $response->toDOM;
254	my $root = $dom->documentElement;
255
256	#FIXME: Provide these as arguments so you're not re-creating them for each response
257	my $xpc = XML::LibXML::XPathContext->new();
258	$xpc->registerNs('oai','http://www.openarchives.org/OAI/2.0/');
259	my $xpath = XML::LibXML::XPathExpression->new("(oai:GetRecord\|oai:ListRecords)/oai:record");
260
261
262	my @records = $xpc->findnodes($xpath,$root);
263	my $now_pretty = DateTime->now();
264
265	$now_pretty->set_formatter($strp);
266	print "Downloaded ".scalar @records." records at $now_pretty\n";
267	foreach my $record (@records) {
268
269	#FIXME: This is where you could put a filter to prevent certain records from being saved...
270
271	#Create a new XML document from the XML fragment
272	my $document = XML::LibXML::Document->new( "1.0", "UTF-8" );
273	$document->setDocumentElement($record);
274	my $record_string = $document->toString;
275
276	#NOTE: We have options at this point.
277	#Option 1: Write documents to disk, and have a separate importer upload the documents
278	#Option 2: Use AnyEvent::HTTP or POE::Component::Client::HTTP to send to a HTTP API asynchronously
279	#Option 3: Write records to a database, and have a separate importer upload the documents
280	#Option 4: Shared memory, although that seems fragile if nothing else
281	#Option 5: Write the records to a socket/pipe
282
283	#NOTE: I wonder which option would be the fastest. For now, we're going to go with Option 1:
284	$self->{digester}->add($record_string);
285	my $digest = $self->{digester}->hexdigest;
286	#FIXME: If a record appears more than once during the download signified by $now, you'll
287	#overwrite the former with the latter. While this acts as a sort of heavy-handed de-duplication,
288	#you need to take into account the importer daemon...
289
290	require Time::HiRes;
291	my $epoch = Time::HiRes::time();
292	my $now = DateTime->from_epoch(epoch => $epoch);
293	$now->set_formatter($strp);
294
295	my $filename = "$now-$digest";
296	#NOTE: Here is where we write the XML out to disk
297	eval {
298	my $state = $document->toFile($filename);
299	};
300	if ($@){
301	die("Error while writing to disk: $@");
302	}
303	}
304
305
306	#NOTE: Check if object has method due to bug in HTTP::OAI which causes fatal error on $response->resumptionToken if no real response is fetched from the OAI-PMH server
307	if ($response->can("resumptionToken")){
308	my $resumption_token = $response->resumptionToken->resumptionToken if $response->resumptionToken && $response->resumptionToken->resumptionToken;
309	if ($resumption_token){
310	#warn "Resumption Token = $resumption_token";
311	my $resumed_response = $self->send_request({set => $set, resumptionToken => $resumption_token});
312	$self->handle_response({ response => $resumed_response, set => $set,});
313	}
314	}
315
316	#In theory $response->resume(resumptionToken => resumptionToken) should kick off another response...
317	warn $response->message if $response->is_error;
318	}
319	}
320
321	1;

Line 0 Link Here

(-)a/Koha/Icarus/Task/Upload/OAIPMH/Biblio.pm (+118 lines)
		1	package Koha::Icarus::Task::Upload::OAIPMH::Biblio;
		2
		3	use Modern::Perl;
		4	use parent 'Koha::Icarus::Task::Base';
		5	use URI;
		6	use LWP::UserAgent;
		7	use HTTP::Status qw(:constants);
		8
		9	my $ua = LWP::UserAgent->new;
		10
		11	#FIXME: If we store the cookie jar on disk, we can prevent unnecessary HTTP requests...
		12	#We would need to make sure that it's stored on a private per-instance basis though...
		13	$ua->cookie_jar({});
		14
		15
		16	sub new {
		17	my ($class, $args) = @_;
		18	$args = {} unless defined $args;
		19	return bless ($args, $class);
		20	}
		21
		22	sub run {
		23	my ( $self ) = @_;
		24
		25	my $task = $self->{task};
		26
		27	if ($self->{Verbosity} && $self->{Verbosity} == 9){
		28	use Data::Dumper;
		29	warn Dumper($task);
		30	}
		31
		32	my $params = $task->{params};
		33
		34
		35
		36
		37	my $queue = $params->{queue};
		38	my $queue_uri = URI->new($queue);
		39
		40	if ($queue_uri->scheme eq 'file'){
		41
		42	my $path = $queue_uri->path;
		43	opendir(my $dh, $path);
		44	my @files = sort readdir($dh);
		45	foreach my $file (@files){
		46	#NOTE: This is plugin specific as the plugins define when they stop to listen for instructions...
		47	my $instruction = $self->listen_for_instruction();
		48	if ($instruction eq 'quit'){
		49	warn "I was asked to quit!";
		50	return;
		51	}
		52
		53	next if $file =~ /^\.+$/;
		54	my $filepath = "$path/$file";
		55	if ( -d $filepath ){
		56	#Do nothing for directories
		57	} elsif ( -e $filepath ){
		58	print "File: $file\n";
		59
		60	#Slurp mode
		61	local $/;
		62	#TODO: Check flock on $filepath first
		63	open( my $fh, '<', $filepath );
		64	my $data = <$fh>;
65
66	#TODO: Improve this section...
67	#Send to Koha API... (we could speed this up using Asynchronous HTTP requests with AnyEvent::HTTP...)
68	my $resp = post_to_api($data,$params);
69
70	my $status = $resp->code;
71
72	if ($status == HTTP_UNAUTHORIZED \|\| $status == HTTP_FORBIDDEN) {
73	$resp = remote_authenticate($params);
74	$resp = post_to_api($data,$params) if $resp->is_success;
75	}
76
77	if ($resp->code == HTTP_OK){
78	print "Success.\n";
79	print $resp->decoded_content;
80	print "\n";
81	unlink $filepath;
82	}
83	}
84	}
85	}
86	}
87
88	sub post_to_api {
89	my ($data, $params) = @_;
90	print "Posting to API...\n";
91	my $resp = $ua->post( $params->{target_uri},
92	{'nomatch_action' => $params->{nomatch_action},
93	'overlay_action' => $params->{overlay_action},
94	'match' => $params->{match},
95	'import_mode' => $params->{import_mode},
96	'framework' => $params->{framework},
97	'item_action' => $params->{item_action},
98	'filter' => $params->{filter},
99	'xml' => $data}
100	);
101	return $resp;
102	}
103
104	sub remote_authenticate {
105	my ($params) = @_;
106	print "Authenticating...\n";
107
108	my $auth_uri = $params->{auth_uri};
109	my $user = $params->{auth_username};
110	my $password = $params->{auth_password};
111	my $resp = $ua->post( $auth_uri, { userid => $user, password => $password } );
112	if ($resp->code == HTTP_OK){
113	print "Authenticated.\n";
114	}
115	return $resp
116	}
117
118	1;

Line 0 Link Here

(-)a/Koha/SavedTask.pm (+86 lines)
		1	package Koha::SavedTask;
		2
		3	# Copyright Prosentient Systems 2016
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 3 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21
		22	use Carp;
		23
		24	use JSON;
		25
		26	use base qw(Koha::Object);
		27
		28
		29
		30	=head1 NAME
		31
		32	Koha::SavedTask -
		33
		34	=head1 API
		35
		36	=head2 Class Methods
		37
		38	=cut
		39
		40
		41
		42	=head3 _type
		43
		44	=cut
		45
		46	sub _type {
		47	return 'SavedTask';
		48	}
		49
		50	sub params_as_perl {
		51	my ($self) = @_;
		52	my $perl = from_json($self->params);
		53	return $perl;
		54	}
		55
		56	sub serialize {
		57	my ($self,$args) = @_;
		58	my $for = $args->{for};
		59	my $type = $args->{type};
		60	if ($for eq 'icarus'){
		61	my $json_params = $self->params;
		62	my $perl_params = from_json($json_params);
		63
		64	my $icarus_task = {
65	type => $self->task_type,
66	start => $self->start_time,
67	repeat_interval => $self->repeat_interval,
68	params => $perl_params,
69	};
70	if ($type eq 'perl'){
71	return $icarus_task;
72	} elsif ($type eq 'json'){
73	my $json = to_json($icarus_task);
74	return $json;
75	}
76	}
77	return undef;
78	}
79
80	=head1 AUTHOR
81
82	David Cook <dcook@prosentient.com.au>
83
84	=cut
85
86	1;

Line 0 Link Here

(-)a/Koha/SavedTasks.pm (+62 lines)
	1	package Koha::SavedTasks;
	2
	3	# Copyright Prosentient Systems 2016
	4	#
	5	# This file is part of Koha.
	6	#
	7	# Koha is free software; you can redistribute it and/or modify it under the
	8	# terms of the GNU General Public License as published by the Free Software
	9	# Foundation; either version 3 of the License, or (at your option) any later
	10	# version.
	11	#
	12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
	13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	15	#
	16	# You should have received a copy of the GNU General Public License along
	17	# with Koha; if not, write to the Free Software Foundation, Inc.,
	18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	19
	20	use Modern::Perl;
	21
	22	use Carp;
	23
	24	use Koha::Database;
	25
	26	use Koha::SavedTask;
	27
	28	use base qw(Koha::Objects);
	29
	30	=head1 NAME
	31
	32	Koha::SavedTasks -
	33
	34	=head1 API
	35
	36	=head2 Class Methods
	37
	38	=cut
	39
	40	=head3 _type
	41
	42	=cut
	43
	44	sub _type {
	45	return 'SavedTask';
	46	}
	47
	48	=head3 object_class
	49
	50	=cut
	51
	52	sub object_class {
	53	return 'Koha::SavedTask';
	54	}
	55
	56	=head1 AUTHOR
	57
	58	David Cook <dcook@prosentient.com.au>
	59
	60	=cut
	61
	62	1;

Line 0 Link Here

(-)a/Koha/Schema/Result/SavedTask.pm (+98 lines)
		1	use utf8;
		2	package Koha::Schema::Result::SavedTask;
		3
		4	# Created by DBIx::Class::Schema::Loader
		5	# DO NOT MODIFY THE FIRST PART OF THIS FILE
		6
		7	=head1 NAME
		8
		9	Koha::Schema::Result::SavedTask
		10
		11	=cut
		12
		13	use strict;
		14	use warnings;
		15
		16	use base 'DBIx::Class::Core';
		17
		18	=head1 TABLE: C<saved_tasks>
		19
		20	=cut
		21
		22	__PACKAGE__->table("saved_tasks");
		23
		24	=head1 ACCESSORS
		25
		26	=head2 task_id
		27
		28	data_type: 'integer'
		29	extra: {unsigned => 1}
		30	is_auto_increment: 1
		31	is_nullable: 0
		32
		33	=head2 start_time
		34
		35	data_type: 'datetime'
		36	datetime_undef_if_invalid: 1
		37	is_nullable: 0
		38
		39	=head2 repeat_interval
		40
		41	data_type: 'integer'
		42	extra: {unsigned => 1}
		43	is_nullable: 0
		44
		45	=head2 task_type
		46
		47	data_type: 'varchar'
		48	is_nullable: 0
		49	size: 255
		50
		51	=head2 params
		52
		53	data_type: 'text'
		54	is_nullable: 0
		55
		56	=cut
		57
		58	__PACKAGE__->add_columns(
		59	"task_id",
		60	{
		61	data_type => "integer",
		62	extra => { unsigned => 1 },
		63	is_auto_increment => 1,
		64	is_nullable => 0,
65	},
66	"start_time",
67	{
68	data_type => "datetime",
69	datetime_undef_if_invalid => 1,
70	is_nullable => 0,
71	},
72	"repeat_interval",
73	{ data_type => "integer", extra => { unsigned => 1 }, is_nullable => 0 },
74	"task_type",
75	{ data_type => "varchar", is_nullable => 0, size => 255 },
76	"params",
77	{ data_type => "text", is_nullable => 0 },
78	);
79
80	=head1 PRIMARY KEY
81
82	=over 4
83
84	=item * L</task_id>
85
86	=back
87
88	=cut
89
90	__PACKAGE__->set_primary_key("task_id");
91
92
93	# Created by DBIx::Class::Schema::Loader v0.07042 @ 2016-01-27 13:35:22
94	# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:gnoi7I9fiXM3IfDysMTm+A
95
96
97	# You can replace this text with custom code or comments, and it will be preserved on regeneration
98	1;

Line 0 Link Here

(-)a/admin/saved_tasks.pl (+371 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright Prosentient Systems 2016
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	=head1 NAME
		21
		22	saved_tasks.pl
		23
		24	=head1 DESCRIPTION
		25
		26	Admin page to manage saved tasks
		27
		28	=cut
		29
		30	use Modern::Perl;
		31	use CGI qw ( -utf8 );
		32	use C4::Auth;
		33	use C4::Output;
		34	use C4::Context;
		35
		36	use Koha::SavedTasks;
		37	use Koha::Icarus;
		38	use Module::Load::Conditional qw/can_load check_install/;
		39	use JSON;
		40
		41	my $try_to_connect = 1;
		42	my $input = new CGI;
		43	my ($template, $loggedinuser, $cookie, $flags) = get_template_and_user( {
		44	template_name => 'admin/saved_tasks.tt',
		45	query => $input,
		46	type => 'intranet',
		47	authnotrequired => 0,
		48	flagsrequired => { 'parameters' => 'parameters_remaining_permissions' },
		49	} );
		50
		51	my $filename = "saved_tasks.pl";
		52	$template->param(
		53	filename => $filename,
		54	);
		55
		56	my $context = C4::Context->new();
		57
		58
		59	my $task_server = $input->param("task_server") // "icarus";
		60
		61
		62	my $socket_uri = $context->{"icarus"}->{"socket"};
		63
		64	my @available_plugins = ();
65	my $task_plugins = $context->{"icarus"}->{"task_plugin"};
66	if ($task_plugins && ref $task_plugins eq 'ARRAY'){
67	#FIXME: This should probably be a module method... validation that a plugin is installed...
68	foreach my $task_plugin (@$task_plugins){
69	#Check that plugin module is installed
70	if ( check_install( module => $task_plugin ) ){
71	push(@available_plugins,$task_plugin);
72	}
73	}
74	}
75
76	$template->param(
77	available_plugins => \@available_plugins,
78	);
79
80	#Server action and task id
81	my $server_action = $input->param("server_action");
82	my $server_task_id = $input->param('server_task_id');
83
84	#Saved task op
85	my $op = $input->param('op');
86	my $step = $input->param('step');
87
88	#Saved task id
89	my $saved_task_id = $input->param('saved_task_id');
90
91
92	#Create Koha-Icarus interface object
93	my $icarus = Koha::Icarus->new({ socket_uri => $socket_uri });
94	my $daemon_status = "";
95
96
97
98	#NOTE: If you're having problems starting the server from the web ui,
99	#remember that Apache must be able to write to icarus.log, icarus.pid, icarus.sock and the directories containing them.
100	if ($server_action && $server_action eq "start_server" ){
101	my $icarusd = $context->{icarus}->{bin};
102	my $KOHA_CONF = $ENV{'KOHA_CONF'};
103	if ( -f $icarusd && $KOHA_CONF){
104	my $start_daemon = "$icarusd -f $KOHA_CONF --daemon -v 9";
105	#NOTE: If the daemon didn't close STDOUT and STDERR itself, we'd need to redirect them to /dev/null them here to prevent Apache from looping/erroring
106	if (system("$start_daemon") == 0){
107	#This means the parent daemon process succeeded. However, it's still possible that the child daemon process has failed.
108	} else {
109	$try_to_connect = 0;
110	$daemon_status = "Start failed";
111	}
112	}
113	}
114
115	if ($try_to_connect){
116	#Connect to Icarus
117	if ( $icarus->connect() ){
118	$daemon_status = "online";
119	if ($server_action){
120	if ($server_action eq 'shutdown_server'){
121	my $response = $icarus->shutdown;
122	if ( $response && (my $action = $response->{action}) ){
123	$daemon_status = $action;
124	}
125	} elsif ($server_action eq 'start' && $server_task_id){
126	my $response = $icarus->start_task({ task_id => $server_task_id });
127	$template->param(
128	task_response => $response,
129	);
130	} elsif ($server_action eq 'remove' && $server_task_id){
131	my $response = $icarus->remove_task({ task_id => $server_task_id });
132	$template->param(
133	task_response => $response,
134	);
135	}
136	}
137	} else {
138	warn "Daemon status: $!";
139	$daemon_status = $!;
140	}
141	}
142
143	$template->param(
144	daemon_status => $daemon_status,
145	);
146
147
148
149	my $params = $input->param("params");
150
151	#NOTE: Parse the parameters manually, so that you can "name[]" style of parameter, which we use in the special plugin templates...
152	my $saved_params = {};
153	#Fetch the names of all the parameters passed to your script
154	my @parameter_names = $input->param;
155	#Iterate through these parameter names and look for "params[]"
156	foreach my $parameter_name (@parameter_names){
157	if ($parameter_name =~ /^params\[(.*)\]$/){
158	#Capture the hash key
159	my $key = $1;
160	#Fetch the actual individual value
161	my $parameter_value = $input->param($parameter_name);
162	if ($parameter_value){
163	$saved_params->{$key} = $parameter_value;
164	}
165	}
166	}
167	if (%$saved_params){
168	my $json = to_json($saved_params, { pretty => 1, });
169	if ($json){
170	$params = $json;
171	}
172	}
173
174	my $start_time = $input->param("start_time");
175	my $repeat_interval = $input->param("repeat_interval");
176	my $task_type = $input->param("task_type");
177	if ($task_type){
178	my $task_template = $task_type;
179	#Create the template name by stripping the colons out of the task type text
180	$task_template =~ s/://g;
181	$template->param(
182	task_template => "tasks/$task_template.inc",
183	);
184	}
185
186
187	if ($op){
188	if ($op eq 'new'){
189
190	} elsif ($op eq 'create'){
191
192	#Validate the $task here
193	if ($step){
194	if ($step eq "one"){
195
196	$op = "new";
197	$template->param(
198	step => "two",
199	task_type => $task_type,
200	);
201	} elsif ($step eq "two"){
202	my $new_task = Koha::SavedTask->new({
203	start_time => $start_time,
204	repeat_interval => $repeat_interval,
205	task_type => $task_type,
206	params => $params,
207	});
208
209	#Serialize the data as an Icarus task
210	my $icarus_task = $new_task->serialize({ for => "icarus", type => "perl", });
211
212	my $valid = 1;
213	#Load the plugin module, and create an object instance in order to validate user-entered data
214	if ( can_load( modules => { $task_type => undef, }, ) ){
215	my $plugin = $task_type->new({ task => $icarus_task, });
216	if ($plugin->can("validate")){
217	my $errors = $plugin->validate({
218	"tests" => "all",
219	});
220	if (%$errors){
221	$template->param(
222	errors => $errors,
223	);
224	}
225	if ($plugin->{invalid_data} > 0){
226	$valid = 0;
227	}
228	}
229	}
230
231	if ($valid){
232	$new_task->store();
233	$op = "list";
234	} else {
235	$op = "new";
236	#Create a Perl data structure from the JSON
237	my $editable_params = from_json($params);
238	$template->param(
239	step => "two",
240	task_type => $task_type,
241	saved_task => $new_task,
242	params => $editable_params,
243	);
244	}
245	}
246	}
247
248	} elsif ($op eq 'edit'){
249	my $task = Koha::SavedTasks->find($saved_task_id);
250	if ($task){
251	#Check if the task's saved task type is actually available...
252	#FIXME: This should be a Koha::Icarus method...
253	my $task_type_is_valid = grep { $task->task_type eq $_ } @available_plugins;
254	$template->param(
255	task_type_is_valid => $task_type_is_valid,
256	saved_task => $task,
257	);
258	}
259	} elsif ($op eq 'update'){
260	if ($step){
261	my $task = Koha::SavedTasks->find($saved_task_id);
262	if ($task){
263	if ($step eq "one"){
264	#We've completed step one, which is choosing the task type,
265	#so now we're going to populate the form for editing the rest of the values
266	$op = "edit";
267	#This is the JSON string that we've saved in the database
268	my $current_params_string = $task->params;
269	my $editable_params = from_json($current_params_string);
270
271	$template->param(
272	step => "two",
273	task_type => $task_type,
274	saved_task => $task,
275	params => $editable_params,
276
277	);
278	} elsif ($step eq "two"){
279	#We've completed step two, so we're storing the data now...
280	$task->set({
281	start_time => $start_time,
282	repeat_interval => $repeat_interval,
283	task_type => $task_type,
284	params => $params,
285	});
286	$task->store;
287	#FIXME: Validate the $task here...
288	if (my $valid = 1){
289	$op = "list";
290	} else {
291	$op = "edit";
292	$template->param(
293	step => "two",
294	task_type => $task_type,
295	saved_task => $task,
296	);
297	}
298	}
299	}
300	}
301	} elsif ($op eq 'send'){
302	my $sent_response;
303	if ($icarus->connected){
304	if ($saved_task_id){
305	#Look up task
306	my $task = Koha::SavedTasks->find($saved_task_id);
307	if ($task){
308	#Create a task for Icarus, and send it to Icarus
309	my $icarus_task = $task->serialize({ for => "icarus", type => "perl", });
310	if ($icarus_task){
311	$icarus->add_task({ task => $icarus_task, });
312	$op = "list";
313	}
314	}
315	}
316	} else {
317	$sent_response = "icarus_offline";
318	$template->param(
319	sent_response => $sent_response,
320	);
321	$op = "list";
322	}
323	} elsif ($op eq 'delete'){
324	my $saved_response = "delete_failure";
325	if ($saved_task_id){
326	#Look up task
327	my $task = Koha::SavedTasks->find($saved_task_id);
328	if ($task){
329	if (my $something = $task->delete){
330	$saved_response = "delete_success";
331	}
332	}
333	}
334	$template->param(
335	saved_response => $saved_response,
336	);
337	$op = "list";
338	} else {
339	#Don't recognize $op, so fallback to list
340	$op = "list";
341	}
342	} else {
343	#No $op, so fallback to list
344	$op = "list";
345	}
346
347	if ($op eq 'list'){
348	#Get active tasks from Icarus
349	if ($icarus->connected){
350	my $tasks = $icarus->list_tasks();
351	if ($tasks && @$tasks){
352	#Sort tasks that come from Icarus, since it returns an unsorted list of hashrefs
353	my @sorted_tasks = sort { $a->{task_id} <=> $b->{task_id} } @$tasks;
354	$template->param(
355	tasks => \@sorted_tasks,
356	);
357	}
358	}
359
360	#Get saved tasks from Koha
361	my @saved_tasks = Koha::SavedTasks->as_list();
362	$template->param(
363	saved_tasks => \@saved_tasks,
364	);
365	}
366
367	$template->param(
368	op => $op,
369	);
370
371	output_html_with_http_headers $input, $cookie, $template->output;

Line 0 Link Here

(-)a/docs/Icarus/README (+35 lines)
	1	TODO:
	2
	3	_ICARUS_
	4	- Improve error handling for Koha::Icarus::Task::Upload::*
	5	- When does it get a status of "Failed"?
	6	- Data validation:
	7	"Koha::Icarus::Task::Upload::OAIPMH::Biblio":
	8	- Validate HTTP URLs and filepaths...
	9	- MAKE IT SO YOU HAVE TO USE A RECORD MATCHING RULE! To at the very least strip the OAI wrapper...
	10	- Add PLUGIN->validate("parameter_names")
	11	- Add PLUGIN->validate("parameter_values")
	12	- For the downloader, this would validate HTTP && OAI-PMH parameters...
	13
	14	#######
	15
	16	ICARUS:
	17	- admin/saved_tasks.pl
	18	- Add a clone button to ease task creation
	19	- Make the "Task type" prettier (and translateable) on saved_tasks.pl.
	20	- Provide more options for the Icarus dashboard? (already have start/shutdown...)
	21	- Add the ability to "edit" and "pause" active Icarus tasks
	22	- A pause function would make debugging much easier.
	23	- Add help pages for WEB GUI
	24	- Make "Koha::Icarus::Task::Upload::OAIPMH::Biblio" use asynchronous HTTP requests to speed up the import
	25	- Instead of using file:///home/koha/koha-dev/var/spool/oaipmh, use something like file:///tmp/koha-instance/koha-dev/oaipmh
	26	- How is the user going to specify file:///tmp/koha-instance/koha-dev/oaipmh? Or do you put this in koha-conf.xml and then make a user-defined relative path?
	27	- WEB UI:
	28	- Add `name` to saved_tasks?
	29	- Move "Saved tasks" from Administration to Tools?
	30	- Look at existing bugs for schedulers:
	31	- https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=14712
	32	- https://bugs.koha-community.org/bugzilla3/show_bug.cgi?id=1993
	33	- Handle datestamp granularity better for OAI-PMH download tasks?
	34
	35

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/tasks/KohaIcarusTaskDownloadOAIPMHBiblio.inc (+87 lines)
		1	[%# USE CGI %]
		2	[%# server_name = CGI.server_name; server_port = CGI.server_port; server = server_name _ ":" _ server_port; %]
		3
		4	<fieldset class="rows">
		5	<legend>HTTP parameters:</legend>
		6	<ol>
		7	<li>
		8	<label for="url">URL: </label>
		9	[% IF ( params.url ) %]
		10	<input type="text" id="url" name="params[url]" value="[% params.url %]" size="30" />
		11	[% ELSE %]
		12	<input type="text" id="url" name="params[url]" value="http://" size="30" />
		13	[% END %]
		14	[% IF (errors.url.no_path) %]<span class="error">[The URL must have a path after "http://" like "koha-community.org/cgi-bin/koha/oai.pl".]</span>[% END %]
		15	[% IF (errors.url.not_http) %]<span class="error">[The URL begin with a scheme of "http://" like "http://koha-community.org/cgi-bin/koha/oai.pl".]</span>[% END %]
		16	[% IF (errors.url.not_a_url) %]<span class="error">[The value of this field must be a URL like "http://koha-community.org/cgi-bin/koha/oai.pl".]</span>[% END %]
		17
		18	</li>
		19	</ol>
		20	<span class="help">The following parameters are not required by all OAI-PMH repositories, so they may be optional for this task.</span>
		21	<ol>
		22	<li>
		23	<label for="username">Username: </label>
		24	<input type="text" id="username" name="params[username]" value="[% params.username %]" size="30" />
		25	</li>
		26	<li>
		27	<label for="password">Password: </label>
		28	<input type="text" id="password" name="params[password]" value="[% params.password %]" size="30" />
		29	</li>
		30	<li>
		31	<label for="realm">Realm: </label>
		32	<input type="text" id="realm" name="params[realm]" value="[% params.realm %]" size="30" />
		33	</li>
		34	</ol>
		35	</fieldset>
		36	<fieldset class="rows">
		37	<legend>OAI-PMH parameters:</legend>
		38	<ol>
		39	<li>
		40	<label for="verb">Verb: </label>
		41	<select id="verb" name="params[verb]">
		42	[% FOREACH verb IN [ 'GetRecord', 'ListRecords' ] %]
		43	[% IF ( params.verb ) && ( verb == params.verb ) %]
		44	<option selected="selected" value="[% verb %]">[% verb %]</option>
		45	[% ELSE %]
		46	<option value="[% verb %]">[% verb %]</option>
		47	[% END %]
		48	[% END %]
		49	</select>
		50	</li>
		51	<li>
		52	<label for="identifier">Identifier: </label>
		53	<input type="text" id="identifier" name="params[identifier]" value="[% params.identifier %]" size="30" />
		54	<span class="help">This identifier will only be used with the GetRecord verb.</span>
		55	</li>
		56	<li>
		57	<label for="sets">Sets: </label>
		58	<input type="text" id="sets" name="params[sets]" value="[% params.sets %]" size="30" /><span class="help">You may specify several sets by separating the sets with a pipe (e.g. set1\|set2 )</span>
		59	</li>
		60	<li>
		61	<label for="metadataPrefix">Metadata Prefix: </label>
		62	<input type="text" id="metadataPrefix" name="params[metadataPrefix]" value="[% params.metadataPrefix %]" size="30" />
		63	</li>
		64	<li>
65	<label for="opt_from">From: </label>
66	<input type="text" class="datetime_utc" id="opt_from" name="params[from]" value="[% params.from %]" size="30" /><span class="help">This value will be treated as UTC time. Note that some repositories only support YYYY-MM-DD datestamps.</span>
67	</li>
68	<li>
69	<label for="opt_until">Until: </label>
70	<input type="text" class="datetime_utc" id="opt_until" name="params[until]" value="[% params.until %]" size="30" /><span class="help">This value will be treated as UTC time. Note that some repositories only support YYYY-MM-DD datestamps.</span>
71	</li>
72	</ol>
73	</fieldset>
74	<fieldset class="rows">
75	<legend>Download parameters:</legend>
76	<ol>
77	<li>
78	<label for="queue">Queue: </label>
79	[% IF ( params.queue ) %]
80	<input type="text" id="queue" name="params[queue]" value="[% params.queue %]" size="30" />
81	[% ELSE %]
82	<input type="text" id="queue" name="params[queue]" value="file://" size="30" />
83	[% END %]
84	<span class="help">This is a filepath on your system like file:///var/spool/koha/libraryname/oaipmh</span>
85	</li>
86	</ol>
87	</fieldset>

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/tasks/KohaIcarusTaskUploadOAIPMHBiblio.inc (+143 lines)
		1	[%# Use CGI plugin to create a default target URI %]
		2	[%# TODO: Test if this works with Plack... %]
		3	[% USE CGI %]
		4	[% server = CGI.virtual_host %]
		5	[% IF ( server_port = CGI.virtual_port ) %]
		6	[% IF ( server_port != '80' ) && ( server_port != '443' ) %]
		7	[% server = server _ ':' _ server_port %]
		8	[% END %]
		9	[% END %]
		10	[% default_auth_uri = 'http://' _ server _ '/cgi-bin/koha/svc/authentication' %]
		11	[% default_target_uri = 'http://' _ server _ '/cgi-bin/koha/svc/import_oai' %]
		12	<fieldset class="rows">
		13	<legend>Import source parameters:</legend>
		14	<ol>
		15	<li>
		16	<label for="queue">Queue: </label>
		17	[% IF ( params.queue ) %]
		18	<input type="text" id="queue" name="params[queue]" value="[% params.queue %]" size="30" />
		19	[% ELSE %]
		20	<input type="text" id="queue" name="params[queue]" value="file://" size="30" />
		21	[% END %]
		22	<span class="help">This is a filepath on your system like file:///var/spool/koha/libraryname/oaipmh</span>
		23	</li>
		24	</ol>
		25	</fieldset>
		26	<fieldset class="rows">
		27	<legend>API authentication parameters:</legend>
		28	<ol>
		29	<li>
		30	<label for="auth_uri">URL: </label>
		31	[% IF ( params.auth_uri ) %]
		32	<input type="text" id="auth_uri" name="params[auth_uri]" value="[% params.auth_uri %]" size="30" />
		33	[% ELSE %]
		34	<input type="text" id="auth_uri" name="params[auth_uri]" value="[% default_auth_uri %]" size="30" />
		35	[% END %]
		36	[% IF (errors.auth_uri.no_path) %]<span class="error">[The URL must have a path after "http://" like "koha-community.org/cgi-bin/koha/svc/authentication".]</span>[% END %]
		37	[% IF (errors.auth_uri.not_http) %]<span class="error">[The URL begin with a scheme of "http://" like "http://koha-community.org/cgi-bin/koha/svc/authentication".]</span>[% END %]
		38	[% IF (errors.auth_uri.not_a_url) %]<span class="error">[The value of this field must be a URL like "http://koha-community.org/cgi-bin/koha/svc/authentication".]</span>[% END %]
		39	<span class="help">This is a Koha authentication URL. The default value </span>
		40	</li>
		41	<li>
		42	<label for="auth_username">Username: </label>
		43	<input type="text" id="auth_username" name="params[auth_username]" value="[% params.auth_username %]" size="30" />
		44	<span class="help">This user must have permission to edit the catalogue.</span>
		45	</li>
		46	<li>
		47	<label for="auth_password">Password: </label>
		48	<input type="text" id="auth_password" name="params[auth_password]" value="[% params.auth_password %]" size="30" />
		49	</li>
		50	</ol>
		51	</fieldset>
		52	<fieldset class="rows">
		53	<legend>Import target parameters:</legend>
		54	<ol>
		55	<li>
		56	<label for="target_uri">URL: </label>
		57	[% IF ( params.target_uri ) %]
		58	<input type="text" id="target_uri" name="params[target_uri]" value="[% params.target_uri %]" size="30" />
		59	[% ELSE %]
		60	<input type="text" id="target_uri" name="params[target_uri]" value="[% default_target_uri %]" size="30" />
		61	[% END %]
		62	[% IF (errors.target_uri.no_path) %]<span class="error">[The URL must have a path after "http://" like "koha-community.org/cgi-bin/koha/svc/import_oai".]</span>[% END %]
		63	[% IF (errors.target_uri.not_http) %]<span class="error">[The URL begin with a scheme of "http://" like "http://koha-community.org/cgi-bin/koha/svc/import_oai".]</span>[% END %]
		64	[% IF (errors.target_uri.not_a_url) %]<span class="error">[The value of this field must be a URL like "http://koha-community.org/cgi-bin/koha/svc/import_oai".]</span>[% END %]
65	</li>
66
67	<li>
68	<label for="match">Record matching rule code</label>
69	<input type="text" id="match" name="params[match]" value="[% params.match %]" size="30" />
70	<span class="help">This code must exist in "Record matching rules" in Administration for record matching to work. (Example code: OAI)</span>
71	</li>
72	<li>
73	[%# TODO: Ideally, I'd like to use 'tools-overlay-action.inc' but the logic doesn't work here. Perhaps it would be better as a TT plugin. %]
74	<label for="overlay_action">Action if matching record found</label>
75	<select name="params[overlay_action]" id="overlay_action">
76	[% IF ( params.overlay_action == "replace" ) %]
77	<option value="replace" selected="selected">
78	[% ELSE %]
79	<option value="replace">
80	[% END %]
81	Replace existing record with incoming record</option>
82	[% IF ( params.overlay_action == "create_new" ) %]
83	<option value="create_new" selected="selected">
84	[% ELSE %]
85	<option value="create_new">
86	[% END %]
87	Add incoming record</option>
88	[% IF ( params.overlay_action == "ignore" ) %]
89	<option value="ignore" selected="selected">
90	[% ELSE %]
91	<option value="ignore">
92	[% END %]
93	Ignore incoming record</option>
94	</select>
95	</li>
96	<li>
97	[%# TODO: Ideally, I'd like to use 'tools-nomatch-action.inc' but the logic doesn't work here. Perhaps it would be better as a TT plugin. %]
98	<label for="nomatch_action">Action if no match is found</label>
99	<select name="params[nomatch_action]" id="nomatch_action">
100	[% IF ( params.nomatch_action == "create_new" ) %]
101	<option value="create_new" selected="selected">
102	[% ELSE %]
103	<option value="create_new">
104	[% END %]
105	Add incoming record</option>
106	[% IF ( params.nomatch_action == "ignore" ) %]
107	<option value="ignore" selected="selected">
108	[% ELSE %]
109	<option value="ignore">
110	[% END %]
111	Ignore incoming record</option>
112	</select>
113	</li>
114	<li>
115	<label for="item_action">Item action</label>
116	[%# TODO: Will you ever have a different mode than ignore? %]
117	<input type="text" id="item_action" value="ignore" size="30" disabled="disabled"/>
118	<input type="hidden" name="params[item_action]" value="ignore" />
119	</li>
120	<li>
121	<label for="import_mode">Import mode: </label>
122	[%# TODO: Will you ever have a different mode than direct? %]
123	<input type="text" id="import_mode" value="direct" size="30" disabled="disabled"/>
124	<input type="hidden" name="params[import_mode]" value="direct" />
125	</li>
126	<li>
127	<label>Framework</label>
128	</li>
129	<li>
130	<label for="filter">Filter</label>
131	[% IF ( params.filter ) %]
132	<input type="text" id="filter" name="params[filter]" value="[% params.filter %]" size="30" />
133	[% ELSE %]
134	<input type="text" id="filter" name="params[filter]" value="file://" size="30" />
135	[% END %]
136	<span class="help">This is a filepath on your system like file:///etc/koha/sites/libraryname/OAI2MARC21slim.xsl or file:///usr/share/koha/intranet/htdocs/intranet-tmpl/prog/en/xslt/OAI2MARC21slim.xsl</span>
137	</li>
138	</li>
139	<li>
140	<label>Record type</label>
141	</li>
142	</ol>
143	</fieldset>

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/saved_tasks.tt (+345 lines)
		1	[% INCLUDE 'doc-head-open.inc' %]
		2	<title>Koha &rsaquo; Administration &rsaquo; Saved tasks</title>
		3	[% INCLUDE 'doc-head-close.inc' %]
		4	[% INCLUDE 'calendar.inc' %]
		5	<script type="text/javascript" src="[% interface %]/lib/jquery/plugins/jquery-ui-timepicker-addon.min.js"></script>
		6	[% INCLUDE 'timepicker.inc' %]
		7	[% IF ( op == "list" ) %]
		8	<link rel="stylesheet" type="text/css" href="[% interface %]/[% theme %]/css/datatables.css" />
		9	[% INCLUDE 'datatables.inc' %]
		10	<script type="text/javascript">
		11	//<![CDATA[
		12	$(document).ready(function() {
		13	$("#taskst").dataTable($.extend(true, {}, dataTablesDefaults, {
		14	"aoColumnDefs": [
		15	{ "aTargets": [3,4,5,6], "bSortable": false },
		16	],
		17	"sPaginationType": "four_button"
		18	}));
		19	});
		20	//]]>
		21	</script>
		22	[% ELSIF ( op == "edit" ) \|\| ( op == "new" ) %]
		23	<script type="text/javascript">
		24	//<![CDATA[
		25	$(document).ready(function() {
		26	[%# Ideally, it would be nice to record the timezone here too, but currently we use MySQL's DATETIME field which doesn't store ISO 8601 timezone designators... %]
		27	$(".datetime_local").datetimepicker({
		28	dateFormat: "yy-mm-dd",
		29	timeFormat: "HH:mm:ss",
		30	hour: 0,
		31	minute: 0,
		32	second: 0,
		33	showSecond: 1,
		34	});
		35	$(".datetime_utc").datetimepicker({
		36	separator: "T",
		37	timeSuffix: 'Z',
		38	dateFormat: "yy-mm-dd",
		39	timeFormat: "HH:mm:ss",
		40	hour: 0,
		41	minute: 0,
		42	second: 0,
		43	showSecond: 1,
		44	// timezone doesn't work with the "Now" button in v1.4.3 although it appears to in v1.6.1
		45	// timezone: +000,
		46	});
		47
		48	});
		49	//]]>
		50	</script>
		51	<style type="text/css">
		52	/* Override staff-global.css which hides second, millisecond, and microsecond sliders */
		53	.ui_tpicker_second {
		54	display: block;
		55	}
		56	.test-success {
		57	/* same color as .text-success in Bootstrap 2.2.2 */
		58	color:#468847;
		59	}
		60	</style>
		61	[% END %]
		62	</head>
		63
		64	<body id="admin_saved_tasks" class="admin">
65	[% INCLUDE 'header.inc' %]
66	[% INCLUDE 'cat-search.inc' %]
67	<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a> &rsaquo; Saved tasks</div>
68
69	<div id="doc3" class="yui-t2">
70
71	<div id="bd">
72	<div id="yui-main">
73	<div class="yui-b">
74	[% IF ( op ) %]
75	[% IF ( op == "new" ) \|\| ( op == "edit" ) %]
76	[%# If step is undefined, force it to be step one %]
77	[% IF ( ! step ); step = "one"; END; %]
78
79
80
81	[%# HEADING %]
82	[% IF ( op == "new" ) %]
83	<h1>New saved task</h1>
84	[% ELSIF ( op == "edit" ) %]
85	<h1>Modify saved task</h1>
86	[% END %]
87	[%# /HEADING %]
88
89	[%# TODO: Get this working properly... <div class="alert">Validation failed.</div> #]
90
91	[%# FORM %]
92	<form action="/cgi-bin/koha/admin/[% filename %]" name="detail-form" method="post" id="saved-task-details" novalidate="novalidate">
93	[% IF ( op == "new" ) %]
94	<input type="hidden" name="op" value="create" />
95	[% ELSIF ( op == "edit" ) %]
96	<input type="hidden" name="op" value="update" />
97	<input type="hidden" name="saved_task_id" value="[% saved_task.task_id %]" />
98	[% END %]
99	<input type="hidden" name="step" value="[% step %]" />
100	<fieldset class="rows">
101	<ol>
102	[% IF ( op == "edit") && ( step == "one" ) && (! task_type_is_valid ) %]
103	<li>
104	<label for="invalid_task_type">Current invalid task type:</label>
105	<input id="invalid_task_type" type="text" disabled="disabled" value="[% saved_task.task_type %]" size="60" />
106	<span class="error">Sorry! This task type is invalid. Please choose a new one from the following list.</span>
107	<li>
108	[% END %]
109	<li>
110	<label for="task_type">Task type: </label>
111	[% IF ( step == "one" ) %]
112	[% IF ( available_plugins ) %]
113	<select id="task_type" name="task_type">
114	[% IF ( op == "new") %]
115	[% FOREACH plugin IN available_plugins %]
116	<option value="[% plugin %]">[% plugin %]</option>
117	[% END %]
118	[% ELSIF ( op == "edit" ) %]
119	[% FOREACH plugin IN available_plugins %]
120	[% IF ( saved_task.task_type == plugin ) %]
121	<option selected="selected" value="[% plugin %]">[% plugin %]</option>
122	[% ELSE %]
123	<option value="[% plugin %]">[% plugin %]</option>
124	[% END %]
125	[% END %]
126	[% END %]
127	</select>
128	[% END %]
129
130	[% ELSIF ( step == "two" ) %]
131	<input type="text" disabled="disabled" value="[% task_type %]" size="60" />
132	<input type="hidden" name="task_type" value="[% task_type %]" />
133	[% END %]
134	</li>
135	</ol>
136	</fieldset>
137
138	[% IF ( step == "one" ) %]
139	<fieldset class="action">
140	<input type="submit" value="Next">
141	<a class="cancel" href="/cgi-bin/koha/admin/[% filename %]">Cancel</a>
142	</fieldset>
143	[% ELSIF ( step == "two" ) %]
144	<fieldset class="rows">
145	<legend>Task:</legend>
146	<ol>
147	<li>
148	<label for="start_time">Start time: </label>
149	<input type="text" id="start_time" class="datetime_local" name="start_time" value="[% saved_task.start_time %]" size="30" />
150	<span class="help">This value will be treated as local server time, and times in the past will start immediately.</span>
151	</li>
152	<li>
153	<label for="repeat_interval">Repeat interval: </label>
154	<input type="text" id="repeat_interval" name="repeat_interval" value="[% saved_task.repeat_interval %]" size="4" />
155	<span class="help">seconds</span>
156	[% IF (errors.repeat_interval.not_numeric) %]<span class="error">[The repeat interval must be a purely numeric value.]</span>[% END %]
157	</li>
158	</ol>
159	</fieldset>
160	[%# Try to include the template, but if it fails, fallback to a regular text view %]
161	[% TRY %]
162	[% INCLUDE $task_template %]
163	[% CATCH %]
164	<fieldset class="rows">
165	<legend>Plugin parameters:</legend>
166	<ol>
167	<li>
168	<label for="params">Params: </label>
169	<textarea id="params" name="params" cols="60" rows="20">[% saved_task.params %]</textarea>
170	</li>
171	</ol>
172	</fieldset>
173	[% END %]
174	<fieldset class="action">
175	<input type="submit" value="Save">
176	<a class="cancel" href="/cgi-bin/koha/admin/[% filename %]">Cancel</a>
177	</fieldset>
178	[% END %]
179	</form>
180	[%# /FORM %]
181	[% END #/edit or new %]
182
183
184	[% IF ( op == "list" ) %]
185	<div id="toolbar" class="btn-toolbar">
186	<a id="newserver" class="btn btn-small" href="/cgi-bin/koha/admin/[% filename %]?op=new"><i class="fa fa-plus"></i> New saved task</a>
187	</div>
188	<h1>Saved tasks</h1>
189	[% IF ( saved_response ) %]
190	[% IF ( saved_response == 'delete_success' ) %]
191	<div class="alert">Deletion successful.</div>
192	[% ELSIF ( saved_response == 'delete_failure' ) %]
193	<div class="alert">Deletion failed.</div>
194	[% END %]
195	[% END %]
196	[% IF ( sent_response ) %]
197	[% IF ( sent_response == 'icarus_offline' ) %]
198	<div class="alert">Send failed. Icarus is currently offline.</div>
199	[% END %]
200	[% END %]
201	<table id="taskst">
202	<thead>
203	<tr>
204	<th>Start time</th>
205	<th>Repeat interval</th>
206	<th>Task type</th>
207	<th>Params</th>
208	<th></th>
209	<th></th>
210	<th></th>
211	</tr>
212	</thead>
213	<tbody>
214	[% FOREACH saved_task IN saved_tasks %]
215	<tr>
216	<td>[% IF ( saved_task.start_time ) != "0000-00-00 00:00:00"; saved_task.start_time; END; %]</td>
217	<td>[% saved_task.repeat_interval %]</td>
218	<td>[% saved_task.task_type %]</td>
219	<td>
220	<ul>
221	[% FOREACH pair IN saved_task.params_as_perl.pairs %]
222	<li>[% pair.key %] => [% pair.value %]</li>
223	[% END %]
224	</ul>
225	</td>
226	<td><a href="/cgi-bin/koha/admin/[% filename %]?op=edit&saved_task_id=[% saved_task.task_id %]">Edit</a></td>
227	<td><a href="/cgi-bin/koha/admin/[% filename %]?op=send&saved_task_id=[% saved_task.task_id %]">Send to Icarus</a></td>
228	<td><a href="/cgi-bin/koha/admin/[% filename %]?op=delete&saved_task_id=[% saved_task.task_id %]">Delete</a></td>
229	</tr>
230	[% END %]
231	</tbody>
232	</table>
233	<div id="daemon_controls">
234	<h1>Icarus dashboard</h1>
235	<table>
236	<tr>
237	<th>Status</th>
238	<th></th>
239	<th></th>
240	</tr>
241	<tr>
242	<td>
243
244	[% IF ( daemon_status == 'No such file or directory' ) #Socket doesn't exist at all %]
245	<span id="icarus_status">Unable to contact</span>
246	[% ELSIF ( daemon_status == 'Permission denied' ) #Apache doesn't have permission to write to socket %]
247	<span id="icarus_status">Permission denied</span>
248	[% ELSIF ( daemon_status == 'Connection refused' ) #Socket exists, but server is down %]
249	<span id="icarus_status">Connection refused</span>
250	[% ELSIF ( daemon_status == 'Start failed' ) %]
251	<span id="icarus_status">Start failed</span>
252	[% ELSIF ( daemon_status == 'online' ) %]
253	<span id="icarus_status">Online</span>
254	[% ELSIF ( daemon_status == 'shutting down' ) %]
255	<span id="icarus_status">Shutting down</span>
256	[% ELSE %]
257	<span id="icarus_status">[% daemon_status %]</span>
258	[% END %]
259	</td>
260	[%# TODO: Also provide controls for starting/restarting Icarus? %]
261	<td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=start_server">Start Icarus</a></td>
262	<td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=shutdown_server">Shutdown Icarus</a></td>
263	</tr>
264	</table>
265	</div>
266	<div id="tasks">
267	<h1>Active Icarus tasks</h1>
268	[% IF ( task_response ) %]
269	[% IF ( task_response.action == 'error' ) %]
270	[% IF ( task_response.error_message ) %]
271	[% IF ( task_response.error_message == 'No such process' ) %]
272	<div class="alert">Task [% task_response.task_id %] does not exist.</div>
273	[% END %]
274	[% END %]
275	[% ELSIF ( task_response.action == 'pending' ) %]
276	<div class="alert">Initialising task [% task_response.task_id %].</div>
277	[% ELSIF ( task_response.action == 'already pending' ) %]
278	<div class="alert">Already initialised task [% task_response.task_id %].</div>
279	[% ELSIF ( task_response.action == 'already started' ) %]
280	<div class="alert">Already started task [% task_response.task_id %].</div>
281	[% ELSIF ( task_response.action == 'removed' ) %]
282	<div class="alert">Removing task [% task_response.task_id %].</div>
283	[% END %]
284	[% END %]
285	[% IF ( tasks ) %]
286	<table>
287	<thead>
288	<tr>
289	<th>Task id</th>
290	<th>Status</th>
291	<th>Next start time (local server time)</th>
292	<th>Repeat interval</th>
293	<th>Task type</th>
294	<th>Params</th>
295	<th></th>
296	<th></th>
297	</tr>
298	</thead>
299	<tbody>
300	[% FOREACH task IN tasks %]
301	<tr>
302	<td>[% task.task_id %]</td>
303	<td>
304	[% SWITCH task.task.status %]
305	[% CASE 'new' %]
306	<span>New</span>
307	[% CASE 'pending' %]
308	<span>Pending</span>
309	[% CASE 'started' %]
310	<span>Started</span>
311	[% CASE 'stopping' %]
312	<span>Stopping</span>
313	[% CASE 'failed' %]
314	<span>Failed</span>
315	[% CASE %]
316	<span>[% task.task.status %]</span>
317	[% END %]
318	</td>
319	<td>[% task.task.start %]</td>
320	<td>[% task.task.repeat_interval %]</td>
321	<td>[% task.task.type %]</td>
322	<td>
323	<ul>
324	[% FOREACH pair IN task.task.params.pairs %]
325	<li>[% pair.key %] => [% pair.value %]</li>
326	[% END %]
327	</ul>
328	</td>
329	<td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=start&server_task_id=[% task.task_id %]">Start</a></td>
330	<td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=remove&server_task_id=[% task.task_id %]">Remove</a></td>
331	</tr>
332	[% END %]
333	</tbody>
334	</table>
335	[% END %]
336	</div>
337	[% END #/list %]
338	[% END #/op %]
339	</div>
340	</div>
341	<div class="yui-b">
342	[% INCLUDE 'admin-menu.inc' %]
343	</div>
344	</div>
345	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/misc/bin/icarusd.pl (+211 lines)
		1	#!/usr/bin/perl
		2
		3	#######################################################################
		4
		5	use Modern::Perl;
		6	use POSIX; #For daemonizing
		7	use Fcntl qw(:flock); #For pidfile
		8	use Getopt::Long;
		9	use Pod::Usage;
		10
		11	#Make the STDOUT filehandle hot, so that you can use shell re-direction. Otherwise, you'll suffer from buffering.
		12	STDOUT->autoflush(1);
		13	#Note that STDERR, by default, is already hot.
		14
		15	#######################################################################
		16	#FIXME: Debugging signals
		17	=pod
		18	BEGIN {
		19	package POE::Kernel;
		20	use constant TRACE_SIGNALS => 1;
		21	use constant ASSERT_USAGE => 1;
		22	use constant ASSERT_DATA => 1;
		23	}
		24	=cut
		25
		26
		27	use POE;
		28	use JSON; #For Listener messages
		29	use XML::LibXML; #For configuration files
		30
		31	use Koha::Icarus::Listener;
		32
		33	#######################################################################
		34
		35	my ($filename,$daemon,$log,$help);
		36	my $verbosity = 1;
		37	GetOptions (
		38	"f\|file\|filename=s" => \$filename, #/kohawebs/dev/dcook/koha-dev/etc/koha-conf.xml
		39	"l\|log=s" => \$log,
		40	"d\|daemon" => \$daemon,
		41	"v=i" => \$verbosity,
		42	"h\|?" => \$help,
		43	) or pod2usage(2);
		44	pod2usage(1) if $help;
		45
		46
		47	if ( ! $filename \|\| ! -f $filename ){
		48	warn "Failed to start.\n";
		49	if ( ! $filename ){
		50	warn("You must provide a valid configuration file using the -f switch.\n");
		51	pod2usage(1);
		52	}
		53	if ( ! -f $filename ){
		54	die(qq{"$filename" is not a file.\n});
		55	}
		56	}
		57
		58	#Declare the variable with file scope so the flock stays for the duration of the process's life
		59	my $pid_filehandle;
		60
		61	#Read configuration file
		62	my $config = read_config_file($filename);
		63
		64	my $SOCK_PATH = $config->{socket} \|\| '';
65	my $pid_file = $config->{pidfile} \|\| '';
66	my $max_tasks = $config->{max_tasks};
67
68	#Overwrite configuration file with command line options
69	if ($log){
70	$config->{log} = $log;
71	}
72
73	#Test file permissions...
74	my @warnings = ();
75	foreach my $file_to_check ($pid_file, $config->{log}){
76	local (*TMP);
77	if ($file_to_check){
78	utime(undef, undef, $file_to_check) \|\| open(TMP, ">>$file_to_check") \|\| push(@warnings,"couldn't touch $file_to_check: $!");
79	}
80	}
81	if (@warnings){
82	foreach my $warning (@warnings){
83	warn $warning;
84	}
85	exit 1;
86	}
87
88	#Go into daemon mode, if user has included flag
89	if ($daemon){
90	daemonize();
91	}
92
93	if ($pid_file){
94	#NOTE: The filehandle needs to have file scope, so that the flock is preserved.
95	$pid_filehandle = make_pid_file($pid_file);
96	}
97
98	#FIXME: Do we want to log to file only in daemon mode? $config->{log} should be populated by either the config file or the l\|log GetOpt...
99	if ($daemon && $config->{log}){
100	log_to_file($config->{log});
101	}
102
103
104	#FIXME: 1) In daemon mode, SIGUSR1 or SIGHUP for reloading/restarting?
105	#######################################################################
106
107	#Creates Icarus Listener
108	Koha::Icarus::Listener->spawn({
109	Socket => $SOCK_PATH,
110	MaxTasks => $max_tasks,
111	Verbosity => $verbosity,
112	});
113
114	POE::Kernel->run();
115
116	exit;
117
118	sub read_config_file {
119	my $filename = shift;
120	my $config = {};
121	if ( -e $filename ){
122	eval {
123	my $doc = XML::LibXML->load_xml(location => $filename);
124	if ($doc){
125	my $root = $doc->documentElement;
126	my $icarus = $root->find('icarus')->shift;
127	if ($icarus){
128	#Get all child nodes for the 'icarus' element
129	my @childnodes = $icarus->childNodes();
130	foreach my $node (@childnodes){
131	#Only consider nodes that are elements
132	if ($node->nodeType == XML_ELEMENT_NODE){
133	my $config_key = $node->nodeName;
134	my $first_child = $node->firstChild;
135	#Only consider nodes that have a text node as their first child
136	if ($first_child && $first_child->nodeType == XML_TEXT_NODE){
137	$config->{$config_key} = $first_child->nodeValue;
138	}
139	}
140	}
141	}
142	}
143	};
144	}
145	return $config;
146	}
147
148	#######################################################################
149	#NOTE: On Debian, you can use the daemon binary to make a process into a daemon,
150	# the following subs are for systems that don't have the daemon binary.
151
152	sub daemonize {
153	my $pid = fork;
154	die "Couldn't fork: $!" unless defined($pid);
155	if ($pid){
156	exit; #Parent exit
157	}
158	POSIX::setsid() or die "Can't start a new session: $!";
159
160	#Change to known system directory
161	chdir('/');
162
163	#Close inherited file handles, so that you can truly run in the background.
164	open STDIN, '<', '/dev/null';
165	open STDOUT, '>', '/dev/null';
166	open STDERR, '>&STDOUT';
167
168	#FIXME: You should probabl rset file creation mask here as well...
169	}
170
171	sub log_to_file {
172	my $logfile = shift;
173	#Open a filehandle to append to a log file
174	open(LOG, '>>', $logfile) or die "Unable to open a filehandle for $logfile: $!\n"; # --output
175	LOG->autoflush(1); #Make filehandle hot (ie don't buffer)
176	STDOUT = LOG; #Re-assign STDOUT to LOG \| --stdout
177	STDERR = STDOUT; #Re-assign STDERR to STDOUT \| --stderr
178	}
179
180	sub make_pid_file {
181	my $pidfile = shift;
182	if ( ! -e $pidfile ){
183	open(my $fh, '>', $pidfile) or die "Unable to write to $pidfile: $!\n";
184	$fh->close;
185	}
186
187	open(my $pidfilehandle, '+<', $pidfile) or die "Unable to open a filehandle for $pidfile: $!\n";
188	if (flock($pidfilehandle, LOCK_EX\|LOCK_NB)){
189	#Write pid to pidfile
190	warn "Acquiring lock on $pidfile\n";
191	#Now that we've acquired a lock, let's truncate the file
192	truncate($pidfilehandle, 0);
193	print $pidfilehandle $$."\n" or die $!;
194	#Flush the filehandle so you're not suffering from buffering
195	$pidfilehandle->flush();
196	return $pidfilehandle;
197	} else {
198	my $number = <$pidfilehandle>;
199	chomp($number);
200	warn "$0 is already running with pid $number. Exiting.\n";
201	exit(1);
202	}
203	}
204
205	__END__
206
207	=head1 SYNOPSIS
208
209	icarusd.pl -f koha-conf.xml [--log icarus.log] [--daemon] [ -v 0-9 ] [-h]
210
211	=cut