Attachment #47675 for bug #10662

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




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::Listener;

use Modern::Perl;
use POE qw(Wheel::ReadWrite Wheel::SocketFactory);
use POE qw(Wheel::Run);
use Data::Dumper; #FIXME: remove this line
use IO::Socket qw(AF_UNIX);
use URI;
use Koha::Icarus::Task;
use DateTime; #For info()

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

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

#NOTE: 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 => {
                shutdown => "shutdown",
                set_verbosity => "set_verbosity",
                _child => "on_task_event",
            },
        ],
        inline_states => {
            got_client_accept => \&on_client_accept,
            got_client_error => \&on_client_error,
            got_server_error => \&on_server_error,
            _start => \&on_server_start,
            got_add_task => \&on_add_task,
            got_list_tasks => \&on_list_tasks,
            graceful_shutdown => \&graceful_shutdown,

#TODO: Obvs, this one has to stay an inline_state...
            got_client_input => $args->{ClientInput},

#FIXME: Just remove this...
            got_client_drop => \&on_client_drop,
        },
#FIXME: You could remove these args as we can just get them from $self in _start...
        args => [
            $args->{Socket},
            $args->{Alias},
            $args->{MaxTasks},
        ],
    );
}

sub on_add_task {
    my ($message, $kernel, $heap, $session) = @_[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->new({ message => $message, server_id => $server_id, });
        return $task_session->ID;
    } else {
        #This die should be caught by the event caller...
        die "Maximum number of tasks already reached.\n";
    }

}

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

    #NOTE: 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}} ){
        #FIXME: How does this work???
        push(@tasks,{ task_id => $task_id, task => $heap->{tasks}->{$task_id}->{task} });
    }
    return \@tasks;
}

#FIXME
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->log($session->ID,"$action child $child_id");

    if ($action eq 'create'){
        #NOTE: The $task variable is returned by the child 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};
    }
}


#FIXME: I think they're using session->ID when they should probably use $heap->{server_id}...
#FIXME: It's a tough one... since the server is started within the session... the session and wheel for the server should be the same...
#TODO: Put this in a parent class?
sub log {
    my ($self,$server_id,$message) = @_;
    if ($self->{Verbosity} > 0){
        my $now = DateTime->now(time_zone => "local");
        say "[$now] [server $server_id] $message";
    }
}

sub info {
    my $server_id = shift;
    my $message = shift;
    my $now = DateTime->now(time_zone => "local");
    say "[$now] [server $server_id] $message";
}











sub on_server_start {
    my ($bind_address_uri,$alias,$max_tasks,$kernel,$heap,$session) = @_[ARG0,ARG1,ARG2,KERNEL,HEAP,SESSION];
    my $server_id = $session->ID;

    $kernel->sig(INT => "graceful_shutdown");
    $kernel->sig(TERM => "graceful_shutdown");
    if ($alias){
        $kernel->alias_set($alias) if $alias;
        $heap->{alias} = $alias;
    }
    $heap->{max_tasks} = $max_tasks // 25; #Default maximum of 25 unless otherwise specified

    info($server_id,"Maximum number of tasks allowed: $heap->{max_tasks}");
    info($server_id,"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) ){
            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;
    }

}

#FIXME: You can probably remove this all together...
sub on_client_drop {
    my ($session, $heap) = @_[SESSION, HEAP];
    my $wheel_id = $_[ARG0];
    delete $heap->{client}->{$wheel_id};
}

#Accept client connection to listener
sub on_client_accept {
    my ($client_socket, $server_wheel_id, $heap, $session) = @_[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;
    info($session->ID,"Connection ".$client_wheel->ID()." started.");
#FIXME: remove these two lines
#    say "New ReadWrite WheelID at ".$client_wheel->ID();
 #   say "SocketFactory WheelID = $server_wheel_id";

}

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

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

    info($session->ID,"Connection $wheel_id failed or ended.");
    delete $heap->{client}->{$wheel_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 shutdown {
    my ($self,$heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];


    if ($heap->{alias}){
        $kernel->alias_remove( $heap->{alias} );
    }

    if ($heap->{server}){
        $self->log($session->ID,"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($session->ID,"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 graceful_shutdown {
    my ($heap,$session,$kernel,$signal) = @_[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}} ){
        info($session->ID,"Waiting for tasks to finish...");
        foreach my $task_id (keys %{$heap->{tasks}}){
            info($session->ID,"Task $task_id still exists...");
            $kernel->post($task_id,"got_task_stop");
        }
    } else {
        info($session->ID,"All tasks have finished");
        $kernel->yield("shutdown");
        return;
    }

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

1;




package Koha::Icarus::Task;

use Modern::Perl;
use POE qw(Wheel::Run);
use Data::Dumper;
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;

    my $message = $args->{message};
    my $server_id = $args->{server_id};

    my $task_session = POE::Session->create(
        inline_states => {
            _start  =>  sub {
                my ($session, $kernel, $heap, $task, $server_id) = @_[SESSION, KERNEL, HEAP, ARG0, ARG1];
                $task->{status} = 'new';
                #Trap terminal signals so that the task can stop gracefully.
                $kernel->sig(INT => "got_terminal_signal");
                $kernel->sig(TERM => "got_terminal_signal");

                my $session_id = $session->ID;
                if ($server_id){
                    $heap->{server_id} = $server_id;
                }

                #Tell the kernel that this task is waiting for an external action (ie keepalive counter)
                $kernel->refcount_increment($session_id,"waiting task");
                $heap->{task} = $task;
                return $task; #FIXME: We probably shouldn't store $task in two places... that will get out of sync
                #Except that it's a reference... so it's all good
            },
             "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,
             "external_done" => \&external_done,
             "got_task_stop" => \&on_task_stop,
             "on_task_init" => \&on_task_init,
             "on_task_start" => \&on_task_start,
        },
        args => [ $message->{task}, $server_id ],
    );
    return $task_session;
}

sub on_terminal_signal {
    my ($signal,$session,$kernel) = @_[ARG0,SESSION,KERNEL];
    say "I've trapped the following signal: $signal.";
    $kernel->call($session, "got_task_stop");
}

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

    if ($heap->{stopping}){
        say "$task_id: I'm already stopping! Be patient!";

    } else {
        say "Task $task_id: I'm trying to stop myself now...";

        #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){
            say "Task $task_id: I have child processes in progress...";
            my $child_processes = $heap->{children_by_pid};
            foreach my $child_pid (keys %$child_processes){
                my $child = $child_processes->{$child_pid};
                say "Task $task_id: I'm 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");
            }
        }
        info($task_id,"I'm also telling the kernel that I don't need to be kept alive anymore.");
#        say "Task $task_id: I'm also telling the kernel that I don't need to be kept alive anymore.";
        $kernel->refcount_decrement($task_id,"waiting task");

    }
}

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

    say "External task is done... what now?";
#FIXME: remove this line
#    say "I think the server is ".$heap->{server_id};

    if ($heap->{stopping}){
        say "I'm stopping";
    } else {
        my $task = $heap->{task};
        if (my $repeat_interval = $task->{repeat_interval}){
            #NOTE: Repeat the task
            $task->{status} = "restarting";
            $kernel->yield("on_task_init");
        } else {
            say "I'm going to stop this task";
            $kernel->yield("got_task_stop");
        }
    }

}

#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 ($session, $kernel, $heap) = @_[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};
            if ( my $dt = $datetime_pattern->parse_datetime($start) ){
                $start = $dt->epoch;
            } elsif ( $epoch_pattern->parse_datetime($start) ){
                #No change required
            } else {
                #If we don't match the datetime_pattern or epoch_pattern, then we start right now.
                $start = time(); #time() returns a UNIX epoch time value
            }

            #FIXME: Make this log properly...
            say "Start task at $start";
            #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;
}

#This is where the magic will happen...
sub on_task_start {
    my ($session, $kernel, $heap) = @_[SESSION, KERNEL, HEAP];
    my $task = $heap->{task};
    $task->{status} = 'started';
    my $task_id = $session->ID;

    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");
        #$task->{start} = time() + $repeat_interval;
    }
    #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) = @_;


            #Shutdown the socket listener on the child process, so there's 0 chance of writing to or reading from the socket in the child process
            my $session = $poe_kernel->get_active_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
            $poe_kernel->call($heap->{server_id},"shutdown");

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


            my $task_type = $task->{type};
            say "Task type = $task_type";
            say "Start = $task->{start}";
            say "Repeat interval = $task->{repeat_interval}";
use Data::Dumper;
warn Dumper($task);
            if ( can_load ( modules => { $task_type => undef, }, ) ){
                my $task_object = $task_type->new({task => $task});
                if ($task_object){
                    #Synchronous action
                    $task_object->run;
                }
            } else {
                die "Couldn't load module $task_type: $Module::Load::Conditional::ERROR"
            }

            #Handle them as you download them... which is going to be slow... unless you use AnyEvent::HTTP or POE::Component::Client::HTTP
            #Or... write them to disk and let an importer handle it! Write them to a specific directory... and then configure the importer to look in that directory with a certain profile...

            #FIXME: Ideally, I'd like to handle different data receivers... I'm going to use file:// protocol for now to write to disk, and think about other protocols...
            #Database would be one option, although like Disk... it's expensive
            #I wonder how well it would work writing to shared memory... I feel like that could be problematic with large amounts of data...
            #For now... why don't you just stick to writing to disk...

            #FIXME: Importer... I think the Importer (Daedalus?) will periodically check the staging area?
            #FIXME: Will that be too slow though? I suppose you could signal the importer?
            #FIXME: You could have it checking every second though... that would be trivial I think. Like the repeat for the harvesting really...
            #You could have the daemon checking every second, and every time it finds something, it could spin up a child worker process to handle things up to a limit of X workers... and then it slows down.
            #

        },
        StdoutEvent  => "got_child_stdout",
        StderrEvent  => "got_child_stderr",
        CloseEvent   => "got_child_close",
        NoSetPgrp => 1, #Keep child processes in same group as parent
    );

    $_[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;

    info($task_id,"child pid ".$child->PID." started as wheel ".$child->ID);
}


# These methods are for communicating with child processes...
# "on_child_*" events are standard from POE::Wheel::Run example
#

# Wheel event, including the wheel's ID
sub on_child_stdout {
    my ($stdout_line, $wheel_id, $session) = @_[ARG0, ARG1, SESSION];

    my $now = DateTime->now();


    my $task_id = $session->ID;
    my $child = $_[HEAP]{children_by_wid}{$wheel_id};
    print "[$now] [task $task_id] [pid ".$child->PID."] STDOUT: $stdout_line\n";
    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 ($stderr_line, $wheel_id, $session) = @_[ARG0, ARG1,SESSION];
    my $now = DateTime->now();
    my $task_id = $session->ID;
    my $child = $_[HEAP]{children_by_wid}{$wheel_id};
    print "[$now] [task $task_id] [pid ".$child->PID."] STDERR: $stderr_line\n";
}

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

    my $task_id = $session->ID;
    my $child = delete $_[HEAP]{children_by_wid}{$wheel_id};

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

}

sub on_child_signal {
    my ($heap,$kernel,$pid,$exit_code,$session) = @_[HEAP,KERNEL,ARG1,ARG2,SESSION];
    my $now = DateTime->now();
    my $task_id = $session->ID;
    #FIXME: Tell the session that it's ready to do the next thing...
    if ($exit_code == 0){
        $kernel->yield("external_done");
    }
    info($task_id,"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};
}

sub info {
    my $task_id = shift;
    my $message = shift;
    my $now = DateTime->now(time_zone => "local");
    say "[$now] [task $task_id] $message";
}


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::Dequeue::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;

#TODO: If we store the cookie jar on disk, we can prevent unnecessary HTTP requests...
$ua->cookie_jar({});

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

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

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

    my $auth_uri = $params->{auth_uri};
    my $target_uri = $params->{target_uri};

    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 ){
                warn "Directory: $file";
            } elsif ( -e $filepath ){
                warn "File: $file";

                #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 = $ua->post( $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});

                my $status = $resp->code;
                #FIXME: DEBUGGING
                warn $status;
                warn $resp->code;
                warn $resp->decoded_content;

                if ($status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN) {
                    my $user = $params->{auth_username};
                    my $password = $params->{auth_password};
                    $resp = $ua->post( $auth_uri, { userid => $user, password => $password } );
                    #FIXME: DEBUGGING
                    warn $resp->code;
                    warn $resp->decoded_content;

                    $resp = $ua->post( $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})
                      if $resp->is_success;
                    #FIXME: DEBUGGING
                    warn $resp->code;
                    warn $resp->decoded_content;
                }
                if ($resp->code == 200){
                    unlink $filepath;
                }
            }
        }
    }
}

1;




package Koha::Icarus::Task::Enqueue::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 ($repeat_interval && $repeat_interval =~ /^\d*$/){
        return undef;
    }
    $self->{invalid_data}++;
    return { not_numeric => 1, };
}

sub validate_url {
    my ($self,$url) = @_;
    my $response = {};
    warn "URL = $url";
    if (my $url_obj = URI->new($url)){
        warn "URL OBJ = $url_obj";
        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};
    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";
    }

}

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};

    #FIXME: Remove this code
    #warn "This is my request";
    use Data::Dumper;
    #warn Dumper($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};
    #Create HTTP::OAI::Harvester object

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

    my $harvester = new HTTP::OAI::Harvester( baseURL => $task_params->{url} );
    if ($harvester){
        $harvester->timeout(5); #The default timeout is 180
        warn "Timeout = ".$harvester->timeout;
        #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 = 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){


        #FIXME: Turn the following into a function so that you can run it recursively...
        #You don't really need any output from this yourself.
        #At the start of each run, you can check to see if you have anything on STDIN...

        my $dom = $response->toDOM;
        my $root = $dom->documentElement;

        #FIXME: Can't you provide these as arguments so you're not re-creating them?
        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);
        warn "Downloaded ".scalar @records." records at $now_pretty";
        foreach my $record (@records) {

            my $document = XML::LibXML::Document->new( "1.0", "UTF-8" );
            $document->setDocumentElement($record);
            my $record_string = $document->toString;

            $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
            my $state = $document->toFile($filename);




            #FIXME: I wonder if it would be faster to send your own HTTP requests and not use HTTP::OAI...

            #FIXME: I wonder if it would be faster to send it through a pipe rather than writing it to disk...
            #FIXME: I wonder if it would be faster to use POE::Component::Client::HTTP (or AnyEvent::HTTP) to send it to a HTTP API

            #FIXME: I wonder if this would be a good stage to send it through Filter middleware... so that you can take advantage of the XML::LibXML structure now

        }
#}
##########
# TODO:
# In theory, you could use the $response->next code and just create a new document using header and metadata as well...
#$rec->header->dom->toString; $rec->metadata->dom->toString;
# I wonder which is faster... might be worth checking later.
##########
        #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::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 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;




#!/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 $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 = "";

#Connect to Icarus
if ( $icarus->connect() ){
    $daemon_status = "online";
    if ($server_action){
        if ($server_action eq 'shutdown'){
            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 {
    $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'){
        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";
                    }
                }
            }
        }
    } 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){
            $template->param(
                tasks => $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;

Line 0 Link Here

(-)a/docs/Icarus/README (+7 lines)
	1	IMPROVEMENTS:
	2
	3
	4	PROBLEMS:
	5
	6
	7	DESIGN CHANGES:

Line 0 Link Here

(-)a/installer/data/mysql/atomicupdate/bug_10662-Build_import_oai_table.sql (+11 lines)
	1	DROP TABLE IF EXISTS import_oai;
	2	CREATE TABLE import_oai (
	3	import_oai_id int(10) unsigned NOT NULL AUTO_INCREMENT,
	4	header_identifier varchar(45) CHARACTER SET utf8 NOT NULL,
	5	header_datestamp datetime NOT NULL,
	6	header_status varchar(45) CHARACTER SET utf8 DEFAULT NULL,
	7	metadata longtext CHARACTER SET utf8 NOT NULL,
	8	last_modified timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
	9	status varchar(45) CHARACTER SET utf8 NOT NULL,
	10	PRIMARY KEY (import_oai_id)
	11	) ENGINE=InnoDB AUTO_INCREMENT=297 DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;




  KEY precedence (precedence)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;

--
-- Table structure for table 'import_oai'
--

DROP TABLE IF EXISTS import_oai;
CREATE TABLE  import_oai (
  import_oai_id int(10) unsigned NOT NULL AUTO_INCREMENT,
  header_identifier varchar(45) CHARACTER SET utf8 NOT NULL,
  header_datestamp datetime NOT NULL,
  header_status varchar(45) CHARACTER SET utf8 DEFAULT NULL,
  metadata longtext CHARACTER SET utf8 NOT NULL,
  last_modified timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
  status varchar(45) CHARACTER SET utf8 NOT NULL,
  PRIMARY KEY (import_oai_id)
) ENGINE=InnoDB AUTO_INCREMENT=297 DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;


/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;




[%# 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>




[%# 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>




[% 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="[% themelang %]/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="icon-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 %]
                <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><pre>[% saved_task.params %]</pre></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>
                    </tr>
                    <tr>
                        <td>

                        [% IF ( daemon_status == 'Permission denied' ) #Apache doesn't have permission to write to socket
                            || ( daemon_status == 'Connection refused' ) #Socket exists, but server is down
                            || ( daemon_status == 'No such file or directory' ) #Socket doesn't exist at all
                        %]
                            <span id="icarus_status">Unable to contact</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=shutdown">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>Type</th>
                                    <th>Repeat interval (seconds)</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 %]
                                        <span>[% task.task.status %]</span>
                                        [% END %]
                                    </td>
                                    <td>[% task.task.start %]</td>
                                    <td>[% task.task.type %]</td>
                                    <td>[% task.task.repeat_interval %]</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' %]




<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0"
    xmlns:marc="http://www.loc.gov/MARC21/slim"
    xmlns:oai="http://www.openarchives.org/OAI/2.0/"
    xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:output method="xml" encoding="UTF-8" indent="yes"/>

    <!-- pass in the OAI-PMH identifier for archival purposes -->
    <xsl:param name="identifier"/>

    <!-- Match the root oai:record element -->
    <xsl:template match="oai:record">
        <!-- Apply templates only to the child metadata element(s) -->
        <xsl:apply-templates select="oai:metadata" />
    </xsl:template>

    <!-- Matches an oai:metadata element -->
    <xsl:template match="oai:metadata">
        <!-- Do nothing but apply templates to child elements -->
        <xsl:apply-templates />
    </xsl:template>

    <xsl:template match="marc:record">
        <xsl:copy>
            <!-- Apply all relevant templates for all attributes and elements -->
            <xsl:apply-templates select="@* | *" mode="copy"/>

            <!-- Add new node (or whatever else you want to do after copying the existing record) -->
            <xsl:if test="$identifier">
                <xsl:element name="datafield" xmlns="http://www.loc.gov/MARC21/slim">
                    <xsl:attribute name="ind1"><xsl:text>8</xsl:text></xsl:attribute>
                    <xsl:attribute name="ind2"><xsl:text> </xsl:text></xsl:attribute>
                    <xsl:attribute name="tag">037</xsl:attribute>

                    <xsl:element name="subfield">
                        <xsl:attribute name="code">a</xsl:attribute>
                        <xsl:value-of select="$identifier"/>
                    </xsl:element>

                    <xsl:element name="subfield">
                        <xsl:attribute name="code">b</xsl:attribute>
                        <xsl:text>OAI-PMH</xsl:text>
                    </xsl:element>
                </xsl:element>
            </xsl:if>
        </xsl:copy>
    </xsl:template>


    <!-- Identity transformation: this template is the workhorse that copies attributes and nodes -->
    <!-- In terms of nodes, it'll apply to the leader, controlfield, and subfields. It won't apply to datafields, as we have a more specific template for those. -->
    <xsl:template match="@* | node()" mode="copy">
        <!-- Create a copy of this attribute or node -->
        <xsl:copy>
            <!-- Recursively apply this template to the attributes and child nodes of this element -->
            <xsl:apply-templates select="@* | node()" mode="copy"/>
        </xsl:copy>
    </xsl:template>

     <xsl:template match="marc:datafield" mode="copy">
        <!-- Add subfields by changing the predicate in the select attribute (e.g. [@code='9' or @code='a']) -->
        <xsl:variable name="child_subfields_to_remove" select="child::*[@code='9']"/>
        <!-- Strip out all $9 subfields, as these provide links to authority records. These will nearly never be correct linkages, so strip them out. -->
        <xsl:choose>
            <xsl:when test="self::node()[@tag = '952' or @tag = '942' or @tag = '999']">
            <!-- STRIP DATAFIELDS -->
            <!-- Add datafields to strip by changing the predicate in the test attribute -->
            <!-- Strip out any 952 tags so that we don't have indexing problems in regards to unexpected items... -->
            <!-- Strip out any 942 tags. They'll contain local data (e.g. 942$c item type) which is local and thus won't correspond with the Koha that is importing these records -->
            <!-- Strip all 999 fields; this isn't strictly necessary though, as "C4::Biblio::_koha_add_biblio" and "C4::Biblio::_koha_add_biblioitem" will typically fix the 999$c and 999$d fields in MARC21 -->
            <!-- NOTE: If you don't strip the 942 field, you'll need to make sure that the item type specified matches one that already exists in Koha or you'll have problems -->
            </xsl:when>
            <xsl:when test="count(child::*) = count($child_subfields_to_remove)">
            <!-- STRIP DATAFIELDS WHICH WILL BECOME EMPTY -->
            <!-- We don't want to output a datafield if we're going to remove all its children, as empty datafields cause fatal errors in MARC::Record -->
            </xsl:when>
            <xsl:otherwise>
                <!-- Create a copy of the datafield element (without attributes or child nodes) -->
                <xsl:copy>
                    <!-- Apply copy templates for datafield attributes -->
                    <xsl:apply-templates select="@*" mode="copy"/>
                    <!-- Apply copy templates for subfield nodes -->
                    <xsl:apply-templates select="marc:subfield[not(self::node() = $child_subfields_to_remove)]" mode="copy"/>
                </xsl:copy>
            </xsl:otherwise>
        </xsl:choose>
    </xsl:template>
</xsl:stylesheet>




<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0"
    xmlns:marc="http://www.loc.gov/MARC21/slim"
    xmlns:oai="http://www.openarchives.org/OAI/2.0/"
    xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:output method="xml" encoding="UTF-8" indent="yes"/>

    <!-- pass in the OAI-PMH identifier for archival purposes -->
    <xsl:param name="identifier"/>

        <!-- Match the root oai:record element -->
    <xsl:template match="oai:record">
        <!-- Apply templates only to the child metadata element(s) -->
        <xsl:apply-templates select="oai:metadata" />
    </xsl:template>

    <!-- Matches an oai:metadata element -->
    <xsl:template match="oai:metadata">
        <!-- Do nothing but apply templates to child elements -->
        <xsl:apply-templates />
    </xsl:template>

    <!-- Identity transformation: this template copies attributes and nodes -->
    <xsl:template match="@* | node()">
        <!-- Create a copy of this attribute or node -->
        <xsl:copy>
            <!-- Recursively apply this template to the attributes and child nodes of this element -->
            <xsl:apply-templates select="@* | node()" />
        </xsl:copy>
    </xsl:template>

    <xsl:template match="marc:record">
        <xsl:copy>
            <!-- Apply all relevant templates for all attributes and elements -->
            <xsl:apply-templates select="@* | node()"/>

            <!-- Add new node (or whatever else you want to do after copying the existing record) -->

            <xsl:text>  </xsl:text><xsl:element name="datafield" xmlns="http://www.loc.gov/MARC21/slim">
                <xsl:attribute name="ind1"><xsl:text>7</xsl:text></xsl:attribute>
                <xsl:attribute name="ind2"><xsl:text> </xsl:text></xsl:attribute>
                <xsl:attribute name="tag">024</xsl:attribute>

                <xsl:element name="subfield">
                    <xsl:attribute name="code">a</xsl:attribute>
                    <xsl:value-of select="/oai:record/oai:header/oai:identifier"/>
                </xsl:element>

                <xsl:element name="subfield">
                    <xsl:attribute name="code">2</xsl:attribute>
                    <xsl:text>uri</xsl:text>
                </xsl:element>
            </xsl:element>
            <!-- Newline -->
            <xsl:text>&#xa;</xsl:text>
        </xsl:copy>
    </xsl:template>







</xsl:stylesheet>




<?xml version="1.0" encoding="UTF-8" ?>
<xsl:stylesheet version="1.0"
    xmlns:oai="http://www.openarchives.org/OAI/2.0/"
    xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:output method="xml" encoding="UTF-8" indent="yes"/>

    <!-- Match the root oai:record element -->
    <xsl:template match="oai:record">
        <!-- Apply templates only to the child metadata element(s) -->
        <xsl:apply-templates select="oai:metadata" />
    </xsl:template>

    <!-- Matches an oai:metadata element -->
    <xsl:template match="oai:metadata">
        <!-- Do nothing but apply templates to child elements -->
        <xsl:apply-templates />
    </xsl:template>

    <!-- Identity transformation: this template copies attributes and nodes -->
    <xsl:template match="@* | node()">
        <!-- Create a copy of this attribute or node -->
        <xsl:copy>
            <!-- Recursively apply this template to the attributes and child nodes of this element -->
            <xsl:apply-templates select="@* | node()" />
        </xsl:copy>
    </xsl:template>
</xsl:stylesheet>




#!/usr/bin/perl

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

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

#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
#BEGIN {
#    package POE::Kernel;
#    use constant TRACE_SIGNALS => 1;
#}
use Data::Dumper; #FIXME: Remove this line

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

use Koha::Icarus::Listener;

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

my ($filename,$daemon,$log);
GetOptions (
    "f|file|filename=s"     => \$filename, #/kohawebs/dev/dcook/koha-dev/etc/koha-conf.xml
    "l|log=s"               => \$log,
    "d|daemon"              => \$daemon,
) or die("Error in command line arguments\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;
}

#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({
    Alias => "listener",
    Socket => $SOCK_PATH,
    ClientInput => \&on_client_input,
    MaxTasks => $max_tasks,
    Verbosity => 1,
});

POE::Kernel->run();

exit;

sub on_client_input {
    my ($input, $wheel_id, $session, $kernel, $heap) = @_[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};

    #FIXME: you probably don't want to log this as it can have auth info...
    #Log the raw client input
    say "Input = $input";

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

    if ( ref $message eq 'HASH' ){
        #Read "command" from client
        if (my $command = $message->{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 ($@){
                    warn $@;
                    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 {
                say "The message contained an invalid command!";
                $client->put("Sorry! That is an invalid command!");
                return;
            }
        } else {
            say "The message was missing a command!";
        }
    } else {
        say "The message was malformed!";
    }
    $client->put("Sorry! That is an invalid message!");
    return;
}

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: $!";
}

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
        print "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);
    }
}




#!/usr/bin/perl

# Copyright 2012 CatalystIT Ltd
# 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, see <http://www.gnu.org/licenses>.
#

use Modern::Perl;
use XML::LibXML;
use URI;
use File::Basename;

use CGI qw ( -utf8 );
use C4::Auth qw/check_api_auth/;
use C4::Context;
use C4::ImportBatch;
use C4::Matcher;
use XML::Simple;

my $query = new CGI;
binmode STDOUT, ':encoding(UTF-8)';

my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
unless ($status eq "ok") {
    print $query->header(-type => 'text/xml', -status => '403 Forbidden');
    print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
    exit 0;
}

my $xml;
if ($query->request_method eq "POST") {
    $xml = $query->param('xml');
}
if ($xml) {
    #TODO: You could probably use $query->Vars here instead...
    my %params = map { $_ => $query->param($_) } $query->param;
    my $result = import_oai($xml, \%params );
    print $query->header(-type => 'text/xml');
    print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1);
} else {
    print $query->header(-type => 'text/xml', -status => '400 Bad Request');
}

exit 0;

sub import_oai {
    my ($inxml, $params) = @_;

    my $result = {};

    my $filter      = delete $params->{filter}      || '';
    my $import_mode = delete $params->{import_mode} || '';
    my $framework   = delete $params->{framework}   || '';

    if (my $matcher_code = delete $params->{match}) {
        $params->{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
    }

    my $batch_id = GetWebserviceBatchId($params);
    unless ($batch_id) {
        $result->{'status'} = "failed";
        $result->{'error'} = "Batch create error";
        return $result;
    }

    #Log it in the import_oai table here...

    #Parse the XML string into a XML::LibXML object
    my $doc = XML::LibXML->load_xml(string => $inxml);

    #Get the root element
    my $root = $doc->documentElement;

    #Register namespaces for searching purposes
    my $xpc = XML::LibXML::XPathContext->new();
    $xpc->registerNs('oai','http://www.openarchives.org/OAI/2.0/');

    my $xpath_identifier = XML::LibXML::XPathExpression->new("oai:header/oai:identifier");
    my $identifier = $xpc->findnodes($xpath_identifier,$root)->shift;
    my $identifier_string = $identifier->textContent;

    my $xpath_datestamp = XML::LibXML::XPathExpression->new("oai:header/oai:datestamp");
    my $datestamp = $xpc->findnodes($xpath_datestamp,$root)->shift;
    my $datestamp_string = $datestamp->textContent;

    my $status_string = "";

    #OAI-PMH Header = identifier, datestamp, status, setSpec?
    #OAI-PMH Metadata

    my $log_dbh = C4::Context->dbh;
    my $log_sql = "INSERT INTO import_oai (header_identifier, header_datestamp, header_status, metadata) VALUES (?, ?, ?, ?)";
    my $log_sth = $log_dbh->prepare($log_sql);
    $log_sth->execute($identifier_string,$datestamp_string,$status_string,$inxml);



    #Filter the OAI-PMH record into a MARCXML record
    my $metadata_xml;

    #Source a default XSLT
    my $htdocs  = C4::Context->config('intrahtdocs');
    my $theme   = C4::Context->preference("template");
    #FIXME: This doesn't work for UNIMARC!
    my $xslfilename = "$htdocs/$theme/en/xslt/OAI2MARC21slim.xsl";

    #FIXME: There's a better way to do these filters...
    if ($filter){
        my $filter_uri = URI->new($filter);
        if ($filter_uri){
            my $scheme = $filter_uri->scheme;
            if ($scheme && $scheme eq "file"){
                my $path = $filter_uri->path;
                #Filters may theoretically be .xsl or .pm files
                my($filename, $dirs, $suffix) = fileparse($path,(".xsl",".pm"));
                if ($suffix && $suffix eq ".xsl"){
                    #If this new path exists, change the filter XSLT to it
                    if ( -f $path ){
                        $xslfilename = $path;
                    }
                }
            }
        }
    }

    if ( -f $xslfilename ){
        #FIXME: Ideally, it would be good to use Koha::XSLT_Handler here... (especially for persistent environments...)
        my $xslt = XML::LibXSLT->new();
        my $style_doc = XML::LibXML->load_xml(location => $xslfilename);
        my $stylesheet = $xslt->parse_stylesheet($style_doc);
        if ($stylesheet){
            my $results = $stylesheet->transform($doc);
            $metadata_xml = $stylesheet->output_as_bytes($results);
        }
    } else {
        $result->{'status'} = "failed";
        $result->{'error'} = "Metadata filter unavailable";
        return $result;
    }









    #Import the MARCXML record into Koha
    my $marcflavour = C4::Context->preference('marcflavour') || 'MARC21';
    my $marc_record = eval {MARC::Record::new_from_xml( $metadata_xml, "utf8", $marcflavour)};
    if ($@) {
        $result->{'status'} = "failed";
        $result->{'error'} = $@;
        return $result;
    }

    my $import_record_id = AddBiblioToBatch($batch_id, 0, $marc_record, "utf8", int(rand(99999)));
    my @import_items_ids = AddItemsToImportBiblio($batch_id, $import_record_id, $marc_record, 'UPDATE COUNTS');

    my $matcher = C4::Matcher->new($params->{record_type} || 'biblio');
    $matcher = C4::Matcher->fetch($params->{matcher_id});
    my $number_of_matches =  BatchFindDuplicates($batch_id, $matcher);

    # XXX we are ignoring the result of this;
    BatchCommitRecords($batch_id, $framework) if lc($import_mode) eq 'direct';

    my $dbh = C4::Context->dbh();
    my $sth = $dbh->prepare("SELECT matched_biblionumber FROM import_biblios WHERE import_record_id =?");
    $sth->execute($import_record_id);
    my $biblionumber=$sth->fetchrow_arrayref->[0] || '';
    $sth = $dbh->prepare("SELECT overlay_status FROM import_records WHERE import_record_id =?");
    $sth->execute($import_record_id);
    my $match_status = $sth->fetchrow_arrayref->[0] || 'no_match';
    my $url = 'http://'. C4::Context->preference('staffClientBaseURL') .'/cgi-bin/koha/catalogue/detail.pl?biblionumber='. $biblionumber;

    $result->{'status'} = "ok";
    $result->{'import_batch_id'} = $batch_id;
    $result->{'match_status'} = $match_status;
    $result->{'biblionumber'} = $biblionumber;
    $result->{'url'} = $url;
    return $result;
}

Return to bug 10662

Lines 3609-3614 CREATE TABLE audio_alerts ( Link Here

(-)a/installer/data/mysql/kohastructure.sql (+17 lines)
3609	KEY precedence (precedence)	3609	KEY precedence (precedence)
3610	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;	3610	) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3611		3611
		3612	--
		3613	-- Table structure for table 'import_oai'
		3614	--
		3615
		3616	DROP TABLE IF EXISTS import_oai;
		3617	CREATE TABLE import_oai (
		3618	import_oai_id int(10) unsigned NOT NULL AUTO_INCREMENT,
		3619	header_identifier varchar(45) CHARACTER SET utf8 NOT NULL,
		3620	header_datestamp datetime NOT NULL,
		3621	header_status varchar(45) CHARACTER SET utf8 DEFAULT NULL,
		3622	metadata longtext CHARACTER SET utf8 NOT NULL,
		3623	last_modified timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
		3624	status varchar(45) CHARACTER SET utf8 NOT NULL,
		3625	PRIMARY KEY (import_oai_id)
		3626	) ENGINE=InnoDB AUTO_INCREMENT=297 DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
		3627
		3628
3612	/!40103 SET TIME_ZONE=@OLD_TIME_ZONE /;	3629	/!40103 SET TIME_ZONE=@OLD_TIME_ZONE /;
3613	/!40101 SET SQL_MODE=@OLD_SQL_MODE /;	3630	/!40101 SET SQL_MODE=@OLD_SQL_MODE /;
3614	/!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS /;	3631	/!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS /;

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/Listener.pm (+285 lines)
		1	package Koha::Icarus::Listener;
		2
		3	use Modern::Perl;
		4	use POE qw(Wheel::ReadWrite Wheel::SocketFactory);
		5	use POE qw(Wheel::Run);
		6	use Data::Dumper; #FIXME: remove this line
		7	use IO::Socket qw(AF_UNIX);
		8	use URI;
		9	use Koha::Icarus::Task;
		10	use DateTime; #For info()
		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	return bless ($args, $class);
		20	}
		21
		22	#NOTE: Inspired by http://poe.perl.org/?POE_Cookbook/Object_Methods
		23	sub spawn {
		24	my ($class, $args) = @_;
		25	my $self = $class->new($args);
		26	POE::Session->create(
		27	object_states => [
		28	$self => {
		29	shutdown => "shutdown",
		30	set_verbosity => "set_verbosity",
		31	_child => "on_task_event",
		32	},
		33	],
		34	inline_states => {
		35	got_client_accept => \&on_client_accept,
		36	got_client_error => \&on_client_error,
		37	got_server_error => \&on_server_error,
		38	_start => \&on_server_start,
		39	got_add_task => \&on_add_task,
		40	got_list_tasks => \&on_list_tasks,
		41	graceful_shutdown => \&graceful_shutdown,
		42
		43	#TODO: Obvs, this one has to stay an inline_state...
		44	got_client_input => $args->{ClientInput},
		45
		46	#FIXME: Just remove this...
		47	got_client_drop => \&on_client_drop,
		48	},
		49	#FIXME: You could remove these args as we can just get them from $self in _start...
		50	args => [
		51	$args->{Socket},
		52	$args->{Alias},
		53	$args->{MaxTasks},
		54	],
		55	);
		56	}
		57
		58	sub on_add_task {
		59	my ($message, $kernel, $heap, $session) = @_[ARG0, KERNEL, HEAP,SESSION];
		60
		61	#Fetch a list of all tasks
		62	my @task_keys = keys %{$heap->{tasks}};
		63
		64	#If the number in the list is less than the max, add a new task
65	#else die.
66	if (scalar @task_keys < $heap->{max_tasks}){
67	my $server_id = $session->ID;
68	my $task_session = Koha::Icarus::Task->new({ message => $message, server_id => $server_id, });
69	return $task_session->ID;
70	} else {
71	#This die should be caught by the event caller...
72	die "Maximum number of tasks already reached.\n";
73	}
74
75	}
76
77	sub on_list_tasks {
78	my ($kernel, $heap,$session) = @_[KERNEL, HEAP,SESSION];
79
80	#NOTE: You can access the POE::Kernel's sessions with "$POE::Kernel::poe_kernel->[POE::Kernel::KR_SESSIONS]".
81	#While it's black magic you shouldn't touch, it can be helpful when debugging.
82
83	my @tasks = ();
84	foreach my $task_id (keys %{$heap->{tasks}} ){
85	#FIXME: How does this work???
86	push(@tasks,{ task_id => $task_id, task => $heap->{tasks}->{$task_id}->{task} });
87	}
88	return \@tasks;
89	}
90
91	#FIXME
92	sub on_task_event {
93	my ($self, $kernel, $heap,$session) = @_[OBJECT,KERNEL, HEAP,SESSION];
94	my ($action,$child_session,$task) = @_[ARG0,ARG1,ARG2];
95
96	my $child_id = $child_session->ID;
97	$self->log($session->ID,"$action child $child_id");
98
99	if ($action eq 'create'){
100	#NOTE: The $task variable is returned by the child session's _start event
101	my $task_id = $child_session->ID;
102	$heap->{tasks}->{$task_id}->{task} = $task;
103
104	} elsif ($action eq 'lose'){
105	my $task_id = $child_session->ID;
106	delete $heap->{tasks}->{$task_id};
107	}
108	}
109
110
111	#FIXME: I think they're using session->ID when they should probably use $heap->{server_id}...
112	#FIXME: It's a tough one... since the server is started within the session... the session and wheel for the server should be the same...
113	#TODO: Put this in a parent class?
114	sub log {
115	my ($self,$server_id,$message) = @_;
116	if ($self->{Verbosity} > 0){
117	my $now = DateTime->now(time_zone => "local");
118	say "[$now] [server $server_id] $message";
119	}
120	}
121
122	sub info {
123	my $server_id = shift;
124	my $message = shift;
125	my $now = DateTime->now(time_zone => "local");
126	say "[$now] [server $server_id] $message";
127	}
128
129
130
131
132
133
134
135
136
137
138
139	sub on_server_start {
140	my ($bind_address_uri,$alias,$max_tasks,$kernel,$heap,$session) = @_[ARG0,ARG1,ARG2,KERNEL,HEAP,SESSION];
141	my $server_id = $session->ID;
142
143	$kernel->sig(INT => "graceful_shutdown");
144	$kernel->sig(TERM => "graceful_shutdown");
145	if ($alias){
146	$kernel->alias_set($alias) if $alias;
147	$heap->{alias} = $alias;
148	}
149	$heap->{max_tasks} = $max_tasks // 25; #Default maximum of 25 unless otherwise specified
150
151	info($server_id,"Maximum number of tasks allowed: $heap->{max_tasks}");
152	info($server_id,"Starting server...");
153
154	my %server_params = (
155	SuccessEvent => "got_client_accept",
156	FailureEvent => "got_server_error",
157	);
158
159	#TODO: At this time, only "unix" sockets are supported. In future, perhaps TCP/IP sockets could also be supported.
160	my $uri = URI->new($bind_address_uri);
161	my $scheme = $uri->scheme;
162
163	if ($scheme eq 'unix'){
164	my $bind_address = $uri->path;
165	$server_params{SocketDomain} = AF_UNIX;
166	$server_params{BindAddress} = $bind_address;
167	#When starting a unix socket server, you need to remove any existing references to that socket file.
168	if ($bind_address && (-e $bind_address) ){
169	unlink $bind_address;
170	}
171	}
172
173	$heap->{server} = POE::Wheel::SocketFactory->new(%server_params);
174
175	if ($scheme eq 'unix'){
176	#FIXME/DEBUGGING: This is a way to force a permission denied error...
177	#chmod 0755, $uri->path;
178	#Make the socket writeable to other users like Apache
179	chmod 0666, $uri->path;
180	}
181
182	}
183
184	#FIXME: You can probably remove this all together...
185	sub on_client_drop {
186	my ($session, $heap) = @_[SESSION, HEAP];
187	my $wheel_id = $_[ARG0];
188	delete $heap->{client}->{$wheel_id};
189	}
190
191	#Accept client connection to listener
192	sub on_client_accept {
193	my ($client_socket, $server_wheel_id, $heap, $session) = @_[ARG0, ARG3, HEAP,SESSION];
194
195	my $client_wheel = POE::Wheel::ReadWrite->new(
196	Handle => $client_socket,
197	InputEvent => "got_client_input",
198	ErrorEvent => "got_client_error",
199	InputFilter => $null_filter,
200	OutputFilter => $null_filter,
201	);
202
203	$client_wheel->put("HELLO");
204	$heap->{client}->{ $client_wheel->ID() } = $client_wheel;
205	info($session->ID,"Connection ".$client_wheel->ID()." started.");
206	#FIXME: remove these two lines
207	# say "New ReadWrite WheelID at ".$client_wheel->ID();
208	# say "SocketFactory WheelID = $server_wheel_id";
209
210	}
211
212	#Handle server error - shutdown server
213	sub on_server_error {
214	my ($operation, $errnum, $errstr, $heap) = @_[ARG0, ARG1, ARG2,HEAP];
215	warn "Server $operation error $errnum: $errstr\n";
216	delete $heap->{server};
217	}
218
219	#Handle client error - including disconnect
220	sub on_client_error {
221	my ($wheel_id,$heap,$session) = @_[ARG3,HEAP,SESSION];
222
223	info($session->ID,"Connection $wheel_id failed or ended.");
224	delete $heap->{client}->{$wheel_id};
225
226	}
227
228
229	#TODO: Put this in a parent class?
230	sub set_verbosity {
231	my ($self,$session,$kernel,$new_verbosity) = @_[OBJECT,SESSION,KERNEL,ARG0];
232	if (defined $new_verbosity){
233	$self->{Verbosity} = $new_verbosity;
234	}
235	}
236
237	sub shutdown {
238	my ($self,$heap,$session,$kernel) = @_[OBJECT, HEAP,SESSION,KERNEL];
239
240
241	if ($heap->{alias}){
242	$kernel->alias_remove( $heap->{alias} );
243	}
244
245	if ($heap->{server}){
246	$self->log($session->ID,"Shutting down server...");
247	#Delete the server, so that you can't get any new connections
248	delete $heap->{server} if $heap->{server};
249	}
250
251	if ($heap->{client}){
252	$self->log($session->ID,"Shutting down any remaining clients...");
253	#Delete the clients, so that you bring down the existing connections
254	delete $heap->{client}; #http://www.perlmonks.org/?node_id=176971
255	}
256	}
257
258	sub graceful_shutdown {
259	my ($heap,$session,$kernel,$signal) = @_[HEAP,SESSION,KERNEL,ARG0];
260
261	#Tell the kernel that you're handling the signal sent to this session
262	$kernel->sig_handled();
263	$kernel->sig($signal);
264
265	my $tasks = $kernel->call($session,"got_list_tasks");
266
267
268	if ( $heap->{tasks} && %{$heap->{tasks}} ){
269	info($session->ID,"Waiting for tasks to finish...");
270	foreach my $task_id (keys %{$heap->{tasks}}){
271	info($session->ID,"Task $task_id still exists...");
272	$kernel->post($task_id,"got_task_stop");
273	}
274	} else {
275	info($session->ID,"All tasks have finished");
276	$kernel->yield("shutdown");
277	return;
278	}
279
280	info($session->ID,"Attempting graceful shutdown in 1 second...");
281	#NOTE: Basically, we just try another graceful shutdown on the next tick.
282	$kernel->delay("graceful_shutdown" => 1);
283	}
284
285	1;

Line 0 Link Here

(-)a/Koha/Icarus/Task.pm (+324 lines)
		1	package Koha::Icarus::Task;
		2
		3	use Modern::Perl;
		4	use POE qw(Wheel::Run);
		5	use Data::Dumper;
		6	use DateTime;
		7	use DateTime::Format::Strptime;
		8	use JSON;
		9	use Module::Load::Conditional qw/can_load/;
		10
		11	my $datetime_pattern = DateTime::Format::Strptime->new(
		12	pattern => '%F %T',
		13	time_zone => 'local',
		14	);
		15	my $epoch_pattern = DateTime::Format::Strptime->new(
		16	pattern => '%s',
		17	);
		18
		19	sub new {
		20	my ($class, $args) = @_;
		21	$args = {} unless defined $args;
		22
		23	my $message = $args->{message};
		24	my $server_id = $args->{server_id};
		25
		26	my $task_session = POE::Session->create(
		27	inline_states => {
		28	_start => sub {
		29	my ($session, $kernel, $heap, $task, $server_id) = @_[SESSION, KERNEL, HEAP, ARG0, ARG1];
		30	$task->{status} = 'new';
		31	#Trap terminal signals so that the task can stop gracefully.
		32	$kernel->sig(INT => "got_terminal_signal");
		33	$kernel->sig(TERM => "got_terminal_signal");
		34
		35	my $session_id = $session->ID;
		36	if ($server_id){
		37	$heap->{server_id} = $server_id;
		38	}
		39
		40	#Tell the kernel that this task is waiting for an external action (ie keepalive counter)
		41	$kernel->refcount_increment($session_id,"waiting task");
		42	$heap->{task} = $task;
		43	return $task; #FIXME: We probably shouldn't store $task in two places... that will get out of sync
		44	#Except that it's a reference... so it's all good
		45	},
		46	"got_child_stdout" => \&on_child_stdout,
		47	"got_child_stderr" => \&on_child_stderr,
		48	"got_child_close" => \&on_child_close,
		49	"got_child_signal" => \&on_child_signal,
		50	"got_terminal_signal" => \&on_terminal_signal,
		51	"external_done" => \&external_done,
		52	"got_task_stop" => \&on_task_stop,
		53	"on_task_init" => \&on_task_init,
		54	"on_task_start" => \&on_task_start,
		55	},
		56	args => [ $message->{task}, $server_id ],
		57	);
		58	return $task_session;
		59	}
		60
		61	sub on_terminal_signal {
		62	my ($signal,$session,$kernel) = @_[ARG0,SESSION,KERNEL];
		63	say "I've trapped the following signal: $signal.";
		64	$kernel->call($session, "got_task_stop");
65	}
66
67	sub on_task_stop {
68	my ($session, $kernel, $heap) = @_[SESSION, KERNEL, HEAP];
69	my $task = $heap->{task};
70	$task->{status} = 'stopping';
71	my $task_id = $session->ID;
72	my $server_id = $heap->{server_id};
73
74	if ($heap->{stopping}){
75	say "$task_id: I'm already stopping! Be patient!";
76
77	} else {
78	say "Task $task_id: I'm trying to stop myself now...";
79
80	#Mark this task as stopping
81	$heap->{stopping} = 1;
82
83	#Stop the task from spawning new jobs
84	$kernel->alarm("on_task_start");
85
86	my $children_by_pid = $heap->{children_by_pid};
87	if ($children_by_pid && %$children_by_pid){
88	say "Task $task_id: I have child processes in progress...";
89	my $child_processes = $heap->{children_by_pid};
90	foreach my $child_pid (keys %$child_processes){
91	my $child = $child_processes->{$child_pid};
92	say "Task $task_id: I'm telling child pid $child_pid to stop";
93	$child->put("quit");
94	#TODO: Perhaps it would be worthwhile having a kill switch too?
95	# my $rv = $child->kill("TERM");
96	}
97	}
98	info($task_id,"I'm also telling the kernel that I don't need to be kept alive anymore.");
99	# say "Task $task_id: I'm also telling the kernel that I don't need to be kept alive anymore.";
100	$kernel->refcount_decrement($task_id,"waiting task");
101
102	}
103	}
104
105	sub external_done {
106	my ($heap,$session,$kernel) = @_[HEAP,SESSION,KERNEL];
107
108	say "External task is done... what now?";
109	#FIXME: remove this line
110	# say "I think the server is ".$heap->{server_id};
111
112	if ($heap->{stopping}){
113	say "I'm stopping";
114	} else {
115	my $task = $heap->{task};
116	if (my $repeat_interval = $task->{repeat_interval}){
117	#NOTE: Repeat the task
118	$task->{status} = "restarting";
119	$kernel->yield("on_task_init");
120	} else {
121	say "I'm going to stop this task";
122	$kernel->yield("got_task_stop");
123	}
124	}
125
126	}
127
128	#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...
129	sub on_task_init {
130	my ($session, $kernel, $heap) = @_[SESSION, KERNEL, HEAP];
131	my $response = 'pending';
132	my $task = $heap->{task};
133	my $status = $task->{status};
134	if ($status){
135	if ($status eq 'started'){
136	$response = 'already started';
137	} elsif ($status eq 'pending'){
138	$response = 'already pending';
139	} else {
140	$task->{status} = 'pending';
141
142
143	my $start = $task->{start};
144	if ( my $dt = $datetime_pattern->parse_datetime($start) ){
145	$start = $dt->epoch;
146	} elsif ( $epoch_pattern->parse_datetime($start) ){
147	#No change required
148	} else {
149	#If we don't match the datetime_pattern or epoch_pattern, then we start right now.
150	$start = time(); #time() returns a UNIX epoch time value
151	}
152
153	#FIXME: Make this log properly...
154	say "Start task at $start";
155	#NOTE: $start must be in UNIX epoch time (ie number of seconds that have elapsed since 00:00:00 UTC Thursday 1 January 1970)
156	$kernel->alarm("on_task_start",$start);
157	}
158	}
159	return $response;
160	}
161
162	#This is where the magic will happen...
163	sub on_task_start {
164	my ($session, $kernel, $heap) = @_[SESSION, KERNEL, HEAP];
165	my $task = $heap->{task};
166	$task->{status} = 'started';
167	my $task_id = $session->ID;
168
169	if (my $repeat_interval = $task->{repeat_interval}){
170	#NOTE: Reset the start time with a human readable timestamp
171	my $dt = DateTime->now( time_zone => 'local', );
172	$dt->add( seconds => $repeat_interval );
173	$task->{start} = $dt->strftime("%F %T");
174	#$task->{start} = time() + $repeat_interval;
175	}
176	#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...
177	#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.
178	my $child = POE::Wheel::Run->new(
179	ProgramArgs => [ $task, ],
180	Program => sub {
181	my ($task) = @_;
182
183
184	#Shutdown the socket listener on the child process, so there's 0 chance of writing to or reading from the socket in the child process
185	my $session = $poe_kernel->get_active_session();
186	my $heap = $session->get_heap();
187	$poe_kernel->call($heap->{server_id},"set_verbosity",0); #This turns off the server logging in this forked process
188	$poe_kernel->call($heap->{server_id},"shutdown");
189
190	#FIXME: I don't know if this really needs to be run...but it probably doesn't hurt...
191	$poe_kernel->stop();
192
193
194	my $task_type = $task->{type};
195	say "Task type = $task_type";
196	say "Start = $task->{start}";
197	say "Repeat interval = $task->{repeat_interval}";
198	use Data::Dumper;
199	warn Dumper($task);
200	if ( can_load ( modules => { $task_type => undef, }, ) ){
201	my $task_object = $task_type->new({task => $task});
202	if ($task_object){
203	#Synchronous action
204	$task_object->run;
205	}
206	} else {
207	die "Couldn't load module $task_type: $Module::Load::Conditional::ERROR"
208	}
209
210	#Handle them as you download them... which is going to be slow... unless you use AnyEvent::HTTP or POE::Component::Client::HTTP
211	#Or... write them to disk and let an importer handle it! Write them to a specific directory... and then configure the importer to look in that directory with a certain profile...
212
213	#FIXME: Ideally, I'd like to handle different data receivers... I'm going to use file:// protocol for now to write to disk, and think about other protocols...
214	#Database would be one option, although like Disk... it's expensive
215	#I wonder how well it would work writing to shared memory... I feel like that could be problematic with large amounts of data...
216	#For now... why don't you just stick to writing to disk...
217
218	#FIXME: Importer... I think the Importer (Daedalus?) will periodically check the staging area?
219	#FIXME: Will that be too slow though? I suppose you could signal the importer?
220	#FIXME: You could have it checking every second though... that would be trivial I think. Like the repeat for the harvesting really...
221	#You could have the daemon checking every second, and every time it finds something, it could spin up a child worker process to handle things up to a limit of X workers... and then it slows down.
222	#
223
224	},
225	StdoutEvent => "got_child_stdout",
226	StderrEvent => "got_child_stderr",
227	CloseEvent => "got_child_close",
228	NoSetPgrp => 1, #Keep child processes in same group as parent
229	);
230
231	$_[KERNEL]->sig_child($child->PID, "got_child_signal");
232	# Wheel events include the wheel's ID.
233	$_[HEAP]{children_by_wid}{$child->ID} = $child;
234	# Signal events include the process ID.
235	$_[HEAP]{children_by_pid}{$child->PID} = $child;
236
237	info($task_id,"child pid ".$child->PID." started as wheel ".$child->ID);
238	}
239
240
241	# These methods are for communicating with child processes...
242	# "on_child_*" events are standard from POE::Wheel::Run example
243	#
244
245	# Wheel event, including the wheel's ID
246	sub on_child_stdout {
247	my ($stdout_line, $wheel_id, $session) = @_[ARG0, ARG1, SESSION];
248
249	my $now = DateTime->now();
250
251
252	my $task_id = $session->ID;
253	my $child = $_[HEAP]{children_by_wid}{$wheel_id};
254	print "[$now] [task $task_id] [pid ".$child->PID."] STDOUT: $stdout_line\n";
255	if ($stdout_line =~ /^UPDATE_PARAMS=(.*)$/){
256	my $json_string = $1;
257	my $json = from_json($json_string);
258	my $task = $_[HEAP]->{task};
259	my $params = $task->{params};
260	foreach my $key (%$json){
261	if (defined $params->{$key}){
262	#FIXME: Don't just overwrite? Only update differences?
263	$params->{$key} = $json->{$key};
264	}
265	}
266	$_[HEAP]->{task} = $task;
267	}
268	}
269
270	# Wheel event, including the wheel's ID.
271	sub on_child_stderr {
272	my ($stderr_line, $wheel_id, $session) = @_[ARG0, ARG1,SESSION];
273	my $now = DateTime->now();
274	my $task_id = $session->ID;
275	my $child = $_[HEAP]{children_by_wid}{$wheel_id};
276	print "[$now] [task $task_id] [pid ".$child->PID."] STDERR: $stderr_line\n";
277	}
278
279	# Wheel event, including the wheel's ID.
280	sub on_child_close {
281	my ($wheel_id,$session,$kernel) = @_[ARG0,SESSION,KERNEL];
282	my $now = DateTime->now();
283
284	my $task_id = $session->ID;
285	my $child = delete $_[HEAP]{children_by_wid}{$wheel_id};
286
287	# May have been reaped by on_child_signal().
288	unless (defined $child) {
289	info($task_id,"[wid $wheel_id] closed all pipes.");
290	return;
291	}
292	info($task_id,"[pid ".$child->PID."] closed all pipes.");
293	delete $_[HEAP]{children_by_pid}{$child->PID};
294
295	}
296
297	sub on_child_signal {
298	my ($heap,$kernel,$pid,$exit_code,$session) = @_[HEAP,KERNEL,ARG1,ARG2,SESSION];
299	my $now = DateTime->now();
300	my $task_id = $session->ID;
301	#FIXME: Tell the session that it's ready to do the next thing...
302	if ($exit_code == 0){
303	$kernel->yield("external_done");
304	}
305	info($task_id,"pid $pid exited with status $exit_code.");
306	my $child = delete $_[HEAP]{children_by_pid}{$pid};
307
308
309
310	# May have been reaped by on_child_close().
311	return unless defined $child;
312
313	delete $_[HEAP]{children_by_wid}{$child->ID};
314	}
315
316	sub info {
317	my $task_id = shift;
318	my $message = shift;
319	my $now = DateTime->now(time_zone => "local");
320	say "[$now] [task $task_id] $message";
321	}
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/Dequeue/OAIPMH/Biblio.pm (+106 lines)
		1	package Koha::Icarus::Task::Dequeue::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	#TODO: If we store the cookie jar on disk, we can prevent unnecessary HTTP requests...
		12	$ua->cookie_jar({});
		13
		14	sub new {
		15	my ($class, $args) = @_;
		16	$args = {} unless defined $args;
		17	return bless ($args, $class);
		18	}
		19
		20	sub run {
		21	my ( $self ) = @_;
		22
		23	my $task = $self->{task};
		24	my $params = $task->{params};
		25
		26	my $auth_uri = $params->{auth_uri};
		27	my $target_uri = $params->{target_uri};
		28
		29	my $queue = $params->{queue};
		30	my $queue_uri = URI->new($queue);
		31
		32	if ($queue_uri->scheme eq 'file'){
		33
		34	my $path = $queue_uri->path;
		35	opendir(my $dh, $path);
		36	my @files = sort readdir($dh);
		37	foreach my $file (@files){
		38	#NOTE: This is plugin specific as the plugins define when they stop to listen for instructions...
		39	my $instruction = $self->listen_for_instruction();
		40	if ($instruction eq 'quit'){
		41	warn "I was asked to quit!";
		42	return;
		43	}
		44
		45	next if $file =~ /^\.+$/;
		46	my $filepath = "$path/$file";
		47	if ( -d $filepath ){
		48	warn "Directory: $file";
		49	} elsif ( -e $filepath ){
		50	warn "File: $file";
		51
		52	#Slurp mode
		53	local $/;
		54	#TODO: Check flock on $filepath first
		55	open( my $fh, '<', $filepath );
		56	my $data = <$fh>;
		57
		58	#TODO: Improve this section...
		59	#Send to Koha API... (we could speed this up using Asynchronous HTTP requests with AnyEvent::HTTP...)
		60	my $resp = $ua->post( $target_uri,
		61	{'nomatch_action' => $params->{nomatch_action},
		62	'overlay_action' => $params->{overlay_action},
		63	'match' => $params->{match},
		64	'import_mode' => $params->{import_mode},
65	'framework' => $params->{framework},
66	'item_action' => $params->{item_action},
67	'filter' => $params->{filter},
68	'xml' => $data});
69
70	my $status = $resp->code;
71	#FIXME: DEBUGGING
72	warn $status;
73	warn $resp->code;
74	warn $resp->decoded_content;
75
76	if ($status == HTTP_UNAUTHORIZED \|\| $status == HTTP_FORBIDDEN) {
77	my $user = $params->{auth_username};
78	my $password = $params->{auth_password};
79	$resp = $ua->post( $auth_uri, { userid => $user, password => $password } );
80	#FIXME: DEBUGGING
81	warn $resp->code;
82	warn $resp->decoded_content;
83
84	$resp = $ua->post( $target_uri,
85	{'nomatch_action' => $params->{nomatch_action},
86	'overlay_action' => $params->{overlay_action},
87	'match' => $params->{match},
88	'import_mode' => $params->{import_mode},
89	'framework' => $params->{framework},
90	'item_action' => $params->{item_action},
91	'filter' => $params->{filter},
92	'xml' => $data})
93	if $resp->is_success;
94	#FIXME: DEBUGGING
95	warn $resp->code;
96	warn $resp->decoded_content;
97	}
98	if ($resp->code == 200){
99	unlink $filepath;
100	}
101	}
102	}
103	}
104	}
105
106	1;

Line 0 Link Here

(-)a/Koha/Icarus/Task/Enqueue/OAIPMH/Biblio.pm (+318 lines)
		1	package Koha::Icarus::Task::Enqueue::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 ($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	warn "URL = $url";
		42	if (my $url_obj = URI->new($url)){
		43	warn "URL OBJ = $url_obj";
		44	if ($url_obj->scheme ne "http"){
		45	$response->{not_http} = 1;
		46	$self->{invalid_data}++;
		47	}
		48	if ( ! $url_obj->path){
		49	$response->{no_path} = 1;
		50	$self->{invalid_data}++;
		51	}
		52	} else {
		53	$response->{not_a_url} = 1;
		54	$self->{invalid_data}++;
		55	}
		56
		57	return $response;
		58	}
		59
		60	sub validate {
		61	my ($self, $args) = @_;
		62	#Reset the invalid data counter...
		63	$self->{invalid_data} = 0;
		64	my $errors = { };
65	my $task = $self->{task};
66	my $tests = $args->{tests};
67	if ($task){
68	if ($tests && $tests eq 'all'){
69	warn "PARAMS = ".$task->{params};
70	}
71	}
72	my $params = $task->{params};
73
74	#validate_start_time
75	$errors->{"repeat_interval"} = $self->validate_repeat_interval($task->{repeat_interval});
76
77	$errors->{"url"} = $self->validate_url($params->{url});
78
79	#NOTE: You don't need to validate these 3 HTTP Basic Auth parameters
80	#validate_username
81	#validate_password
82	#validate_realm
83
84	#OAI-PMH parameters
85	#validate_verb
86	#validate_sets
87	#validate_marcxml
88	#validate_from
89	#validate_until
90
91	#Download parameters
92	#validate_queue
93
94	return $errors;
95	}
96
97	sub new {
98	my ($class, $args) = @_;
99	$args = {} unless defined $args;
100	$args->{invalid_data} = 0;
101	return bless ($args, $class);
102	}
103
104	sub validate_queue {
105	my ( $self ) = @_;
106	my $task = $self->{task};
107	if (my $queue = $task->{params}->{queue}){
108
109	my $queue_uri = URI->new($queue);
110	#TODO: In theory, you could even use a DBI DSN like DBI:mysql:database=koha;host=koha.db;port=3306.
111	#Then you could provide the table, username, and password in the params as well...
112
113	#NOTE: If the queue directory doesn't exist on the filesystem, we try to make it and change to it.
114	if ($queue_uri->scheme eq 'file'){
115	my $filepath = $queue_uri->file;
116	if ( ! -d $filepath ){
117	make_path($filepath,{ mode => 0755 });
118	}
119	if ( -d $filepath ){
120	chdir $filepath or die "$!";
121	}
122	}
123
124	}
125	}
126
127	sub run {
128	my ( $self ) = @_;
129	$self->validate_queue;
130
131	my $task = $self->{task};
132	my $params = $task->{params};
133
134	my $now = DateTime->now(); #This is in UTC time, which is required by the OAI-PMH protocol.
135	if ( $oai_second_granularity->parse_datetime($params->{from}) ){
136	$now->set_formatter($oai_second_granularity);
137	} else {
138	$now->set_formatter($oai_day_granularity);
139	}
140
141	$params->{until} = "$now" if $task->{repeat_interval};
142
143	$self->{digester} = Digest::MD5->new();
144	$self->create_harvester;
145	my $sets = $self->prepare_sets;
146
147	#Send a OAI-PMH request for each set
148	foreach my $set (@{$sets}){
149	my $response = $self->send_request({set => $set});
150	$self->handle_response({ response => $response, set => $set,});
151	}
152
153	#FIXME: Do you want to update the task only when the task is finished, or
154	#also after each resumption?
155	#Update the task params in Icarus after the task is finished...
156	#TODO: This really does make it seem like you should be handling the repeat_interval within the child process rather than the parent...
157	if ($task->{repeat_interval}){
158	$params->{from} = "$now";
159	$params->{until} = "";
160	my $json_update = to_json($params);
161	say STDOUT "UPDATE_PARAMS=$json_update";
162	}
163
164	}
165
166	sub send_request {
167	my ( $self, $args ) = @_;
168
169	#NOTE: This is plugin specific as the plugins define when they stop to listen for instructions...
170	#NOTE: Before sending a new request, check if Icarus has already asked us to quit.
171	my $instruction = $self->listen_for_instruction();
172	if ($instruction eq 'quit'){
173	warn "I was asked to quit!";
174	return;
175	}
176
177
178	my $set = $args->{set};
179	my $resumptionToken = $args->{resumptionToken};
180
181	my $response;
182	my $task_params = $self->{task}->{params};
183
184	#FIXME: Remove this code
185	#warn "This is my request";
186	use Data::Dumper;
187	#warn Dumper($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	#Create HTTP::OAI::Harvester object
212
213	#FIXME: DEBUGGING
214	#use HTTP::OAI::Debug qw(+);
215
216	my $harvester = new HTTP::OAI::Harvester( baseURL => $task_params->{url} );
217	if ($harvester){
218	$harvester->timeout(5); #The default timeout is 180
219	warn "Timeout = ".$harvester->timeout;
220	#Set HTTP Basic Authentication Credentials
221	my $uri = URI->new($task_params->{url});
222	my $host = $uri->host;
223	my $port = $uri->port;
224	$harvester->credentials($host.":".$port, $task_params->{realm}, $task_params->{username}, $task_params->{password});
225	}
226	$self->{harvester} = $harvester;
227	}
228
229	sub prepare_sets {
230	my ( $self ) = @_;
231	my $task_params = $self->{task}->{params};
232	my @sets = split(/\\|/, $task_params->{sets});
233	#If no sets are defined, create a null element to force the foreach loop to run once
234	if (!@sets){
235	push(@sets,undef)
236	}
237	return \@sets;
238	}
239
240	sub handle_response {
241	my ( $self, $args ) = @_;
242	my $params = $self->{task}->{params};
243	my $response = $args->{response};
244	my $set = $args->{set};
245	if ($response){
246
247
248	#FIXME: Turn the following into a function so that you can run it recursively...
249	#You don't really need any output from this yourself.
250	#At the start of each run, you can check to see if you have anything on STDIN...
251
252	my $dom = $response->toDOM;
253	my $root = $dom->documentElement;
254
255	#FIXME: Can't you provide these as arguments so you're not re-creating them?
256	my $xpc = XML::LibXML::XPathContext->new();
257	$xpc->registerNs('oai','http://www.openarchives.org/OAI/2.0/');
258	my $xpath = XML::LibXML::XPathExpression->new("(oai:GetRecord\|oai:ListRecords)/oai:record");
259
260
261	my @records = $xpc->findnodes($xpath,$root);
262	my $now_pretty = DateTime->now();
263
264	$now_pretty->set_formatter($strp);
265	warn "Downloaded ".scalar @records." records at $now_pretty";
266	foreach my $record (@records) {
267
268	my $document = XML::LibXML::Document->new( "1.0", "UTF-8" );
269	$document->setDocumentElement($record);
270	my $record_string = $document->toString;
271
272	$self->{digester}->add($record_string);
273	my $digest = $self->{digester}->hexdigest;
274	#FIXME: If a record appears more than once during the download signified by $now, you'll
275	#overwrite the former with the latter. While this acts as a sort of heavy-handed de-duplication,
276	#you need to take into account the importer daemon...
277	require Time::HiRes;
278	my $epoch = Time::HiRes::time();
279	my $now = DateTime->from_epoch(epoch => $epoch);
280	$now->set_formatter($strp);
281	my $filename = "$now-$digest";
282	#NOTE: Here is where we write the XML out to disk
283	my $state = $document->toFile($filename);
284
285
286
287
288	#FIXME: I wonder if it would be faster to send your own HTTP requests and not use HTTP::OAI...
289
290	#FIXME: I wonder if it would be faster to send it through a pipe rather than writing it to disk...
291	#FIXME: I wonder if it would be faster to use POE::Component::Client::HTTP (or AnyEvent::HTTP) to send it to a HTTP API
292
293	#FIXME: I wonder if this would be a good stage to send it through Filter middleware... so that you can take advantage of the XML::LibXML structure now
294
295	}
296	#}
297	##########
298	# TODO:
299	# In theory, you could use the $response->next code and just create a new document using header and metadata as well...
300	#$rec->header->dom->toString; $rec->metadata->dom->toString;
301	# I wonder which is faster... might be worth checking later.
302	##########
303	#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
304	if ($response->can("resumptionToken")){
305	my $resumption_token = $response->resumptionToken->resumptionToken if $response->resumptionToken && $response->resumptionToken->resumptionToken;
306	if ($resumption_token){
307	warn "Resumption Token = $resumption_token";
308	my $resumed_response = $self->send_request({set => $set, resumptionToken => $resumption_token});
309	$self->handle_response({ response => $resumed_response, set => $set,});
310	}
311	}
312
313	#In theory $response->resume(resumptionToken => resumptionToken) should kick off another response...
314	warn $response->message if $response->is_error;
315	}
316	}
317
318	1;

Line 0 Link Here

(-)a/Koha/SavedTask.pm (+80 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 serialize {
		51	my ($self,$args) = @_;
		52	my $for = $args->{for};
		53	my $type = $args->{type};
		54	if ($for eq 'icarus'){
		55	my $json_params = $self->params;
		56	my $perl_params = from_json($json_params);
		57
		58	my $icarus_task = {
		59	type => $self->task_type,
		60	start => $self->start_time,
		61	repeat_interval => $self->repeat_interval,
		62	params => $perl_params,
		63	};
		64	if ($type eq 'perl'){
65	return $icarus_task;
66	} elsif ($type eq 'json'){
67	my $json = to_json($icarus_task);
68	return $json;
69	}
70	}
71	return undef;
72	}
73
74	=head1 AUTHOR
75
76	David Cook <dcook@prosentient.com.au>
77
78	=cut
79
80	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 (+338 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 $input = new CGI;
		42	my ($template, $loggedinuser, $cookie, $flags) = get_template_and_user( {
		43	template_name => 'admin/saved_tasks.tt',
		44	query => $input,
		45	type => 'intranet',
		46	authnotrequired => 0,
		47	flagsrequired => { 'parameters' => 'parameters_remaining_permissions' },
		48	} );
		49
		50	my $filename = "saved_tasks.pl";
		51	$template->param(
		52	filename => $filename,
		53	);
		54
		55	my $context = C4::Context->new();
		56
		57
		58	my $task_server = $input->param("task_server") // "icarus";
		59
		60
		61	my $socket_uri = $context->{"icarus"}->{"socket"};
		62
		63	my @available_plugins = ();
		64	my $task_plugins = $context->{"icarus"}->{"task_plugin"};
65	if ($task_plugins && ref $task_plugins eq 'ARRAY'){
66	#FIXME: This should probably be a module method... validation that a plugin is installed...
67	foreach my $task_plugin (@$task_plugins){
68	#Check that plugin module is installed
69	if ( check_install( module => $task_plugin ) ){
70	push(@available_plugins,$task_plugin);
71	}
72	}
73	}
74
75	$template->param(
76	available_plugins => \@available_plugins,
77	);
78
79	#Server action and task id
80	my $server_action = $input->param("server_action");
81	my $server_task_id = $input->param('server_task_id');
82
83	#Saved task op
84	my $op = $input->param('op');
85	my $step = $input->param('step');
86
87	#Saved task id
88	my $saved_task_id = $input->param('saved_task_id');
89
90
91	#Create Koha-Icarus interface object
92	my $icarus = Koha::Icarus->new({ socket_uri => $socket_uri });
93	my $daemon_status = "";
94
95	#Connect to Icarus
96	if ( $icarus->connect() ){
97	$daemon_status = "online";
98	if ($server_action){
99	if ($server_action eq 'shutdown'){
100	my $response = $icarus->shutdown;
101	if ( $response && (my $action = $response->{action}) ){
102	$daemon_status = $action;
103	}
104	} elsif ($server_action eq 'start' && $server_task_id){
105	my $response = $icarus->start_task({ task_id => $server_task_id });
106	$template->param(
107	task_response => $response,
108	);
109	} elsif ($server_action eq 'remove' && $server_task_id){
110	my $response = $icarus->remove_task({ task_id => $server_task_id });
111	$template->param(
112	task_response => $response,
113	);
114	}
115	}
116	} else {
117	$daemon_status = $!;
118	}
119	$template->param(
120	daemon_status => $daemon_status,
121	);
122
123
124
125	my $params = $input->param("params");
126
127	#NOTE: Parse the parameters manually, so that you can "name[]" style of parameter, which we use in the special plugin templates...
128	my $saved_params = {};
129	#Fetch the names of all the parameters passed to your script
130	my @parameter_names = $input->param;
131	#Iterate through these parameter names and look for "params[]"
132	foreach my $parameter_name (@parameter_names){
133	if ($parameter_name =~ /^params\[(.*)\]$/){
134	#Capture the hash key
135	my $key = $1;
136	#Fetch the actual individual value
137	my $parameter_value = $input->param($parameter_name);
138	if ($parameter_value){
139	$saved_params->{$key} = $parameter_value;
140	}
141	}
142	}
143	if (%$saved_params){
144	my $json = to_json($saved_params, { pretty => 1, });
145	if ($json){
146	$params = $json;
147	}
148	}
149
150	my $start_time = $input->param("start_time");
151	my $repeat_interval = $input->param("repeat_interval");
152	my $task_type = $input->param("task_type");
153	if ($task_type){
154	my $task_template = $task_type;
155	#Create the template name by stripping the colons out of the task type text
156	$task_template =~ s/://g;
157	$template->param(
158	task_template => "tasks/$task_template.inc",
159	);
160	}
161
162
163	if ($op){
164	if ($op eq 'new'){
165
166	} elsif ($op eq 'create'){
167
168	#Validate the $task here
169	if ($step){
170	if ($step eq "one"){
171
172	$op = "new";
173	$template->param(
174	step => "two",
175	task_type => $task_type,
176	);
177	} elsif ($step eq "two"){
178	my $new_task = Koha::SavedTask->new({
179	start_time => $start_time,
180	repeat_interval => $repeat_interval,
181	task_type => $task_type,
182	params => $params,
183	});
184
185	#Serialize the data as an Icarus task
186	my $icarus_task = $new_task->serialize({ for => "icarus", type => "perl", });
187
188	my $valid = 1;
189	#Load the plugin module, and create an object instance in order to validate user-entered data
190	if ( can_load( modules => { $task_type => undef, }, ) ){
191	my $plugin = $task_type->new({ task => $icarus_task, });
192	if ($plugin->can("validate")){
193	my $errors = $plugin->validate({
194	"tests" => "all",
195	});
196	if (%$errors){
197	$template->param(
198	errors => $errors,
199	);
200	}
201	if ($plugin->{invalid_data} > 0){
202	$valid = 0;
203	}
204	}
205	}
206
207	if ($valid){
208	$new_task->store();
209	$op = "list";
210	} else {
211	$op = "new";
212	#Create a Perl data structure from the JSON
213	my $editable_params = from_json($params);
214	$template->param(
215	step => "two",
216	task_type => $task_type,
217	saved_task => $new_task,
218	params => $editable_params,
219	);
220	}
221	}
222	}
223
224	} elsif ($op eq 'edit'){
225	my $task = Koha::SavedTasks->find($saved_task_id);
226	if ($task){
227	#Check if the task's saved task type is actually available...
228	#FIXME: This should be a Koha::Icarus method...
229	my $task_type_is_valid = grep { $task->task_type eq $_ } @available_plugins;
230	$template->param(
231	task_type_is_valid => $task_type_is_valid,
232	saved_task => $task,
233	);
234	}
235	} elsif ($op eq 'update'){
236	if ($step){
237	my $task = Koha::SavedTasks->find($saved_task_id);
238	if ($task){
239	if ($step eq "one"){
240	#We've completed step one, which is choosing the task type,
241	#so now we're going to populate the form for editing the rest of the values
242	$op = "edit";
243	#This is the JSON string that we've saved in the database
244	my $current_params_string = $task->params;
245	my $editable_params = from_json($current_params_string);
246
247	$template->param(
248	step => "two",
249	task_type => $task_type,
250	saved_task => $task,
251	params => $editable_params,
252
253	);
254	} elsif ($step eq "two"){
255	#We've completed step two, so we're storing the data now...
256	$task->set({
257	start_time => $start_time,
258	repeat_interval => $repeat_interval,
259	task_type => $task_type,
260	params => $params,
261	});
262	$task->store;
263	#FIXME: Validate the $task here...
264	if (my $valid = 1){
265	$op = "list";
266	} else {
267	$op = "edit";
268	$template->param(
269	step => "two",
270	task_type => $task_type,
271	saved_task => $task,
272	);
273	}
274	}
275	}
276	}
277	} elsif ($op eq 'send'){
278	if ($icarus->connected){
279	if ($saved_task_id){
280	#Look up task
281	my $task = Koha::SavedTasks->find($saved_task_id);
282	if ($task){
283	#Create a task for Icarus, and send it to Icarus
284	my $icarus_task = $task->serialize({ for => "icarus", type => "perl", });
285	if ($icarus_task){
286	$icarus->add_task({ task => $icarus_task, });
287	$op = "list";
288	}
289	}
290	}
291	}
292	} elsif ($op eq 'delete'){
293	my $saved_response = "delete_failure";
294	if ($saved_task_id){
295	#Look up task
296	my $task = Koha::SavedTasks->find($saved_task_id);
297	if ($task){
298	if (my $something = $task->delete){
299	$saved_response = "delete_success";
300	}
301	}
302	}
303	$template->param(
304	saved_response => $saved_response,
305	);
306	$op = "list";
307	} else {
308	#Don't recognize $op, so fallback to list
309	$op = "list";
310	}
311	} else {
312	#No $op, so fallback to list
313	$op = "list";
314	}
315
316	if ($op eq 'list'){
317	#Get active tasks from Icarus
318	if ($icarus->connected){
319	my $tasks = $icarus->list_tasks();
320	if ($tasks && @$tasks){
321	$template->param(
322	tasks => $tasks,
323	);
324	}
325	}
326
327	#Get saved tasks from Koha
328	my @saved_tasks = Koha::SavedTasks->as_list();
329	$template->param(
330	saved_tasks => \@saved_tasks,
331	);
332	}
333
334	$template->param(
335	op => $op,
336	);
337
338	output_html_with_http_headers $input, $cookie, $template->output;

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/tasks/KohaIcarusTaskDequeueOAIPMHBiblio.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/includes/tasks/KohaIcarusTaskEnqueueOAIPMHBiblio.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/modules/admin/saved_tasks.tt (+319 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="[% themelang %]/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="icon-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	<table id="taskst">
197	<thead>
198	<tr>
199	<th>Start time</th>
200	<th>Repeat interval</th>
201	<th>Task type</th>
202	<th>Params</th>
203	<th></th>
204	<th></th>
205	<th></th>
206	</tr>
207	</thead>
208	<tbody>
209	[% FOREACH saved_task IN saved_tasks %]
210	<tr>
211	<td>[% IF ( saved_task.start_time ) != "0000-00-00 00:00:00"; saved_task.start_time; END; %]</td>
212	<td>[% saved_task.repeat_interval %]</td>
213	<td>[% saved_task.task_type %]</td>
214	<td><pre>[% saved_task.params %]</pre></td>
215	<td><a href="/cgi-bin/koha/admin/[% filename %]?op=edit&saved_task_id=[% saved_task.task_id %]">Edit</a></td>
216	<td><a href="/cgi-bin/koha/admin/[% filename %]?op=send&saved_task_id=[% saved_task.task_id %]">Send to Icarus</a></td>
217	<td><a href="/cgi-bin/koha/admin/[% filename %]?op=delete&saved_task_id=[% saved_task.task_id %]">Delete</a></td>
218	</tr>
219	[% END %]
220	</tbody>
221	</table>
222	<div id="daemon_controls">
223	<h1>Icarus dashboard</h1>
224	<table>
225	<tr>
226	<th>Status</th>
227	<th></th>
228	</tr>
229	<tr>
230	<td>
231
232	[% IF ( daemon_status == 'Permission denied' ) #Apache doesn't have permission to write to socket
233	\|\| ( daemon_status == 'Connection refused' ) #Socket exists, but server is down
234	\|\| ( daemon_status == 'No such file or directory' ) #Socket doesn't exist at all
235	%]
236	<span id="icarus_status">Unable to contact</span>
237	[% ELSIF ( daemon_status == 'online' ) %]
238	<span id="icarus_status">Online</span>
239	[% ELSIF ( daemon_status == 'shutting down' ) %]
240	<span id="icarus_status">Shutting down</span>
241	[% ELSE %]
242	<span id="icarus_status">[% daemon_status %]</span>
243	[% END %]
244	</td>
245	[%# TODO: Also provide controls for starting/restarting Icarus? %]
246	<td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=shutdown">Shutdown Icarus</a></td>
247	</tr>
248	</table>
249	</div>
250	<div id="tasks">
251	<h1>Active Icarus tasks</h1>
252	[% IF ( task_response ) %]
253	[% IF ( task_response.action == 'error' ) %]
254	[% IF ( task_response.error_message ) %]
255	[% IF ( task_response.error_message == 'No such process' ) %]
256	<div class="alert">Task [% task_response.task_id %] does not exist.</div>
257	[% END %]
258	[% END %]
259	[% ELSIF ( task_response.action == 'pending' ) %]
260	<div class="alert">Initialising task [% task_response.task_id %].</div>
261	[% ELSIF ( task_response.action == 'already pending' ) %]
262	<div class="alert">Already initialised task [% task_response.task_id %].</div>
263	[% ELSIF ( task_response.action == 'already started' ) %]
264	<div class="alert">Already started task [% task_response.task_id %].</div>
265	[% ELSIF ( task_response.action == 'removed' ) %]
266	<div class="alert">Removing task [% task_response.task_id %].</div>
267	[% END %]
268	[% END %]
269	[% IF ( tasks ) %]
270	<table>
271	<thead>
272	<tr>
273	<th>Task id</th>
274	<th>Status</th>
275	<th>Next start time (local server time)</th>
276	<th>Type</th>
277	<th>Repeat interval (seconds)</th>
278	<th></th>
279	<th></th>
280	</tr>
281	</thead>
282	<tbody>
283	[% FOREACH task IN tasks %]
284	<tr>
285	<td>[% task.task_id %]</td>
286	<td>
287	[% SWITCH task.task.status %]
288	[% CASE 'new' %]
289	<span>New</span>
290	[% CASE 'pending' %]
291	<span>Pending</span>
292	[% CASE 'started' %]
293	<span>Started</span>
294	[% CASE 'stopping' %]
295	<span>Stopping</span>
296	[% CASE %]
297	<span>[% task.task.status %]</span>
298	[% END %]
299	</td>
300	<td>[% task.task.start %]</td>
301	<td>[% task.task.type %]</td>
302	<td>[% task.task.repeat_interval %]</td>
303	<td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=start&server_task_id=[% task.task_id %]">Start</a></td>
304	<td><a href="/cgi-bin/koha/admin/[% filename %]?server_action=remove&server_task_id=[% task.task_id %]">Remove</a></td>
305	</tr>
306	[% END %]
307	</tbody>
308	</table>
309	[% END %]
310	</div>
311	[% END #/list %]
312	[% END #/op %]
313	</div>
314	</div>
315	<div class="yui-b">
316	[% INCLUDE 'admin-menu.inc' %]
317	</div>
318	</div>
319	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/xslt/MARC21slimFromOAI.xsl (+88 lines)
		1	<?xml version="1.0" encoding="UTF-8"?>
		2	<xsl:stylesheet version="1.0"
		3	xmlns:marc="http://www.loc.gov/MARC21/slim"
		4	xmlns:oai="http://www.openarchives.org/OAI/2.0/"
		5	xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
		6	<xsl:output method="xml" encoding="UTF-8" indent="yes"/>
		7
		8	<!-- pass in the OAI-PMH identifier for archival purposes -->
		9	<xsl:param name="identifier"/>
		10
		11	<!-- Match the root oai:record element -->
		12	<xsl:template match="oai:record">
		13	<!-- Apply templates only to the child metadata element(s) -->
		14	<xsl:apply-templates select="oai:metadata" />
		15	</xsl:template>
		16
		17	<!-- Matches an oai:metadata element -->
		18	<xsl:template match="oai:metadata">
		19	<!-- Do nothing but apply templates to child elements -->
		20	<xsl:apply-templates />
		21	</xsl:template>
		22
		23	<xsl:template match="marc:record">
		24	<xsl:copy>
		25	<!-- Apply all relevant templates for all attributes and elements -->
		26	<xsl:apply-templates select="@* \| *" mode="copy"/>
		27
		28	<!-- Add new node (or whatever else you want to do after copying the existing record) -->
		29	<xsl:if test="$identifier">
		30	<xsl:element name="datafield" xmlns="http://www.loc.gov/MARC21/slim">
		31	<xsl:attribute name="ind1"><xsl:text>8</xsl:text></xsl:attribute>
		32	<xsl:attribute name="ind2"><xsl:text> </xsl:text></xsl:attribute>
		33	<xsl:attribute name="tag">037</xsl:attribute>
		34
		35	<xsl:element name="subfield">
		36	<xsl:attribute name="code">a</xsl:attribute>
		37	<xsl:value-of select="$identifier"/>
		38	</xsl:element>
		39
		40	<xsl:element name="subfield">
		41	<xsl:attribute name="code">b</xsl:attribute>
		42	<xsl:text>OAI-PMH</xsl:text>
		43	</xsl:element>
		44	</xsl:element>
		45	</xsl:if>
		46	</xsl:copy>
		47	</xsl:template>
		48
		49
		50	<!-- Identity transformation: this template is the workhorse that copies attributes and nodes -->
		51	<!-- In terms of nodes, it'll apply to the leader, controlfield, and subfields. It won't apply to datafields, as we have a more specific template for those. -->
		52	<xsl:template match="@* \| node()" mode="copy">
		53	<!-- Create a copy of this attribute or node -->
		54	<xsl:copy>
		55	<!-- Recursively apply this template to the attributes and child nodes of this element -->
		56	<xsl:apply-templates select="@* \| node()" mode="copy"/>
		57	</xsl:copy>
		58	</xsl:template>
		59
		60	<xsl:template match="marc:datafield" mode="copy">
		61	<!-- Add subfields by changing the predicate in the select attribute (e.g. [@code='9' or @code='a']) -->
		62	<xsl:variable name="child_subfields_to_remove" select="child::*[@code='9']"/>
		63	<!-- Strip out all $9 subfields, as these provide links to authority records. These will nearly never be correct linkages, so strip them out. -->
		64	<xsl:choose>
65	<xsl:when test="self::node()[@tag = '952' or @tag = '942' or @tag = '999']">
66	<!-- STRIP DATAFIELDS -->
67	<!-- Add datafields to strip by changing the predicate in the test attribute -->
68	<!-- Strip out any 952 tags so that we don't have indexing problems in regards to unexpected items... -->
69	<!-- Strip out any 942 tags. They'll contain local data (e.g. 942$c item type) which is local and thus won't correspond with the Koha that is importing these records -->
70	<!-- Strip all 999 fields; this isn't strictly necessary though, as "C4::Biblio::_koha_add_biblio" and "C4::Biblio::_koha_add_biblioitem" will typically fix the 999$c and 999$d fields in MARC21 -->
71	<!-- NOTE: If you don't strip the 942 field, you'll need to make sure that the item type specified matches one that already exists in Koha or you'll have problems -->
72	</xsl:when>
73	<xsl:when test="count(child::*) = count($child_subfields_to_remove)">
74	<!-- STRIP DATAFIELDS WHICH WILL BECOME EMPTY -->
75	<!-- We don't want to output a datafield if we're going to remove all its children, as empty datafields cause fatal errors in MARC::Record -->
76	</xsl:when>
77	<xsl:otherwise>
78	<!-- Create a copy of the datafield element (without attributes or child nodes) -->
79	<xsl:copy>
80	<!-- Apply copy templates for datafield attributes -->
81	<xsl:apply-templates select="@*" mode="copy"/>
82	<!-- Apply copy templates for subfield nodes -->
83	<xsl:apply-templates select="marc:subfield[not(self::node() = $child_subfields_to_remove)]" mode="copy"/>
84	</xsl:copy>
85	</xsl:otherwise>
86	</xsl:choose>
87	</xsl:template>
88	</xsl:stylesheet>

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/xslt/StripOAIWrapper.xsl (+27 lines)
	1	<?xml version="1.0" encoding="UTF-8" ?>
	2	<xsl:stylesheet version="1.0"
	3	xmlns:oai="http://www.openarchives.org/OAI/2.0/"
	4	xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
	5	<xsl:output method="xml" encoding="UTF-8" indent="yes"/>
	6
	7	<!-- Match the root oai:record element -->
	8	<xsl:template match="oai:record">
	9	<!-- Apply templates only to the child metadata element(s) -->
	10	<xsl:apply-templates select="oai:metadata" />
	11	</xsl:template>
	12
	13	<!-- Matches an oai:metadata element -->
	14	<xsl:template match="oai:metadata">
	15	<!-- Do nothing but apply templates to child elements -->
	16	<xsl:apply-templates />
	17	</xsl:template>
	18
	19	<!-- Identity transformation: this template copies attributes and nodes -->
	20	<xsl:template match="@* \| node()">
	21	<!-- Create a copy of this attribute or node -->
	22	<xsl:copy>
	23	<!-- Recursively apply this template to the attributes and child nodes of this element -->
	24	<xsl:apply-templates select="@* \| node()" />
	25	</xsl:copy>
	26	</xsl:template>
	27	</xsl:stylesheet>

Line 0 Link Here

(-)a/misc/bin/icarusd.pl (+257 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
		10	#Make the STDOUT filehandle hot, so that you can use shell re-direction. Otherwise, you'll suffer from buffering.
		11	STDOUT->autoflush(1);
		12	#Note that STDERR, by default, is already hot.
		13
		14	#######################################################################
		15	#FIXME: Debugging signals
		16	#BEGIN {
		17	# package POE::Kernel;
		18	# use constant TRACE_SIGNALS => 1;
		19	#}
		20	use Data::Dumper; #FIXME: Remove this line
		21
		22	use POE;
		23	use JSON; #For Listener messages
		24	use XML::LibXML; #For configuration files
		25
		26	use Koha::Icarus::Listener;
		27
		28	#######################################################################
		29
		30	my ($filename,$daemon,$log);
		31	GetOptions (
		32	"f\|file\|filename=s" => \$filename, #/kohawebs/dev/dcook/koha-dev/etc/koha-conf.xml
		33	"l\|log=s" => \$log,
		34	"d\|daemon" => \$daemon,
		35	) or die("Error in command line arguments\n");
		36
		37	#Declare the variable with file scope so the flock stays for the duration of the process's life
		38	my $pid_filehandle;
		39
		40	#Read configuration file
		41	my $config = read_config_file($filename);
		42
		43	my $SOCK_PATH = $config->{socket};
		44	my $pid_file = $config->{pidfile};
		45	my $max_tasks = $config->{max_tasks};
		46
		47	#Overwrite configuration file with command line options
		48	if ($log){
		49	$config->{log} = $log;
		50	}
		51
		52	#Go into daemon mode, if user has included flag
		53	if ($daemon){
		54	daemonize();
		55	}
		56
		57	if ($pid_file){
		58	#NOTE: The filehandle needs to have file scope, so that the flock is preserved.
		59	$pid_filehandle = make_pid_file($pid_file);
		60	}
		61
		62	#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...
		63	if ($daemon && $config->{log}){
		64	log_to_file($config->{log});
65	}
66
67
68	#FIXME: 1) In daemon mode, SIGUSR1 or SIGHUP for reloading/restarting?
69	#######################################################################
70
71	#Creates Icarus Listener
72	Koha::Icarus::Listener->spawn({
73	Alias => "listener",
74	Socket => $SOCK_PATH,
75	ClientInput => \&on_client_input,
76	MaxTasks => $max_tasks,
77	Verbosity => 1,
78	});
79
80	POE::Kernel->run();
81
82	exit;
83
84	sub on_client_input {
85	my ($input, $wheel_id, $session, $kernel, $heap) = @_[ARG0, ARG1, SESSION, KERNEL, HEAP];
86
87	#Store server id more explicitly
88	my $server_id = $session->ID;
89
90	#Server listener has received input from client
91	my $client = $heap->{client}->{$wheel_id};
92
93	#FIXME: you probably don't want to log this as it can have auth info...
94	#Log the raw client input
95	say "Input = $input";
96
97	#Parse input from client
98	my $message = from_json($input);
99
100	if ( ref $message eq 'HASH' ){
101	#Read "command" from client
102	if (my $command = $message->{command}){
103	if ($command eq 'add task'){
104	my $output = {};
105
106	#Create a task session
107	eval {
108	#NOTE: The server automatically keeps track of its child tasks
109	my $task_id = $kernel->call($server_id,"got_add_task",$message);
110
111	$output->{action} = "added";
112	$output->{task_id} = $task_id;
113	};
114	if ($@){
115	warn $@;
116	chomp($@);
117	$output->{action} = "error";
118	$output->{error_message} = $@;
119	}
120	my $server_output = to_json($output);
121	$client->put($server_output);
122	return;
123
124	} elsif ( ($command eq 'remove task') \|\| ($command eq 'start task' ) ){
125
126	my $task_id = $message->{task_id};
127
128	my $output = {
129	task_id => $task_id,
130	};
131
132	if ($command eq 'remove task'){
133	$kernel->call($task_id,"got_task_stop");
134	$output->{action} = "removed";
135	} elsif ($command eq 'start task'){
136	my $response = $kernel->call($task_id, "on_task_init");
137	$output->{action} = $response;
138	}
139
140	if ($!){
141	$output->{action} = "error";
142	$output->{error_message} = $!;
143	}
144
145	#FIXME: What do we actually want to send back to the client?
146	my $server_output = to_json($output);
147	$client->put($server_output);
148	return;
149
150	} elsif ($command eq 'list tasks'){
151
152	#Get tasks from listener (ie self)
153	my $tasks = $kernel->call($server_id, "got_list_tasks");
154
155	#Prepare output for client
156	my $server_output = to_json({tasks => $tasks}, {pretty => 1});
157
158	#Send output to client
159	$client->put($server_output);
160	return;
161
162	} elsif ($command eq 'shutdown'){
163	$kernel->post($server_id, "graceful_shutdown");
164	my $server_output = to_json({action => 'shutting down'});
165	$client->put($server_output);
166	return;
167	} else {
168	say "The message contained an invalid command!";
169	$client->put("Sorry! That is an invalid command!");
170	return;
171	}
172	} else {
173	say "The message was missing a command!";
174	}
175	} else {
176	say "The message was malformed!";
177	}
178	$client->put("Sorry! That is an invalid message!");
179	return;
180	}
181
182	sub read_config_file {
183	my $filename = shift;
184	my $config = {};
185	if ( -e $filename ){
186	eval {
187	my $doc = XML::LibXML->load_xml(location => $filename);
188	if ($doc){
189	my $root = $doc->documentElement;
190	my $icarus = $root->find('icarus')->shift;
191	if ($icarus){
192	#Get all child nodes for the 'icarus' element
193	my @childnodes = $icarus->childNodes();
194	foreach my $node (@childnodes){
195	#Only consider nodes that are elements
196	if ($node->nodeType == XML_ELEMENT_NODE){
197	my $config_key = $node->nodeName;
198	my $first_child = $node->firstChild;
199	#Only consider nodes that have a text node as their first child
200	if ($first_child && $first_child->nodeType == XML_TEXT_NODE){
201	$config->{$config_key} = $first_child->nodeValue;
202	}
203	}
204	}
205	}
206	}
207	};
208	}
209	return $config;
210	}
211
212	#######################################################################
213	#NOTE: On Debian, you can use the daemon binary to make a process into a daemon,
214	# the following subs are for systems that don't have the daemon binary.
215
216	sub daemonize {
217	my $pid = fork;
218	die "Couldn't fork: $!" unless defined($pid);
219	if ($pid){
220	exit; #Parent exit
221	}
222	POSIX::setsid() or die "Can't start a new session: $!";
223	}
224
225	sub log_to_file {
226	my $logfile = shift;
227	#Open a filehandle to append to a log file
228	open(LOG, '>>', $logfile) or die "Unable to open a filehandle for $logfile: $!\n"; # --output
229	LOG->autoflush(1); #Make filehandle hot (ie don't buffer)
230	STDOUT = LOG; #Re-assign STDOUT to LOG \| --stdout
231	STDERR = STDOUT; #Re-assign STDERR to STDOUT \| --stderr
232	}
233
234	sub make_pid_file {
235	my $pidfile = shift;
236	if ( ! -e $pidfile ){
237	open(my $fh, '>', $pidfile) or die "Unable to write to $pidfile: $!\n";
238	$fh->close;
239	}
240
241	open(my $pidfilehandle, '+<', $pidfile) or die "Unable to open a filehandle for $pidfile: $!\n";
242	if (flock($pidfilehandle, LOCK_EX\|LOCK_NB)){
243	#Write pid to pidfile
244	print "Acquiring lock on $pidfile\n";
245	#Now that we've acquired a lock, let's truncate the file
246	truncate($pidfilehandle, 0);
247	print $pidfilehandle $$."\n" or die $!;
248	#Flush the filehandle so you're not suffering from buffering
249	$pidfilehandle->flush();
250	return $pidfilehandle;
251	} else {
252	my $number = <$pidfilehandle>;
253	chomp($number);
254	warn "$0 is already running with pid $number. Exiting.\n";
255	exit(1);
256	}
257	}

Line 0 Link Here

(-)a/svc/import_oai (-1 / +197 lines)
0	-	1	#!/usr/bin/perl
		2
		3	# Copyright 2012 CatalystIT Ltd
		4	# Copyright 2016 Prosentient Systems
		5	#
		6	# This file is part of Koha.
		7	#
		8	# Koha is free software; you can redistribute it and/or modify it
		9	# under the terms of the GNU General Public License as published by
		10	# the Free Software Foundation; either version 3 of the License, or
		11	# (at your option) any later version.
		12	#
		13	# Koha is distributed in the hope that it will be useful, but
		14	# WITHOUT ANY WARRANTY; without even the implied warranty of
		15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		16	# GNU General Public License for more details.
		17	#
		18	# You should have received a copy of the GNU General Public License
		19	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		20	#
		21
		22	use Modern::Perl;
		23	use XML::LibXML;
		24	use URI;
		25	use File::Basename;
		26
		27	use CGI qw ( -utf8 );
		28	use C4::Auth qw/check_api_auth/;
		29	use C4::Context;
		30	use C4::ImportBatch;
		31	use C4::Matcher;
		32	use XML::Simple;
		33
		34	my $query = new CGI;
		35	binmode STDOUT, ':encoding(UTF-8)';
		36
		37	my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
		38	unless ($status eq "ok") {
		39	print $query->header(-type => 'text/xml', -status => '403 Forbidden');
		40	print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
		41	exit 0;
		42	}
		43
		44	my $xml;
		45	if ($query->request_method eq "POST") {
		46	$xml = $query->param('xml');
		47	}
		48	if ($xml) {
		49	#TODO: You could probably use $query->Vars here instead...
		50	my %params = map { $_ => $query->param($_) } $query->param;
		51	my $result = import_oai($xml, \%params );
		52	print $query->header(-type => 'text/xml');
		53	print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1);
		54	} else {
		55	print $query->header(-type => 'text/xml', -status => '400 Bad Request');
		56	}
		57
		58	exit 0;
		59
		60	sub import_oai {
		61	my ($inxml, $params) = @_;
		62
		63	my $result = {};
		64
		65	my $filter = delete $params->{filter} \|\| '';
66	my $import_mode = delete $params->{import_mode} \|\| '';
67	my $framework = delete $params->{framework} \|\| '';
68
69	if (my $matcher_code = delete $params->{match}) {
70	$params->{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
71	}
72
73	my $batch_id = GetWebserviceBatchId($params);
74	unless ($batch_id) {
75	$result->{'status'} = "failed";
76	$result->{'error'} = "Batch create error";
77	return $result;
78	}
79
80	#Log it in the import_oai table here...
81
82	#Parse the XML string into a XML::LibXML object
83	my $doc = XML::LibXML->load_xml(string => $inxml);
84
85	#Get the root element
86	my $root = $doc->documentElement;
87
88	#Register namespaces for searching purposes
89	my $xpc = XML::LibXML::XPathContext->new();
90	$xpc->registerNs('oai','http://www.openarchives.org/OAI/2.0/');
91
92	my $xpath_identifier = XML::LibXML::XPathExpression->new("oai:header/oai:identifier");
93	my $identifier = $xpc->findnodes($xpath_identifier,$root)->shift;
94	my $identifier_string = $identifier->textContent;
95
96	my $xpath_datestamp = XML::LibXML::XPathExpression->new("oai:header/oai:datestamp");
97	my $datestamp = $xpc->findnodes($xpath_datestamp,$root)->shift;
98	my $datestamp_string = $datestamp->textContent;
99
100	my $status_string = "";
101
102	#OAI-PMH Header = identifier, datestamp, status, setSpec?
103	#OAI-PMH Metadata
104
105	my $log_dbh = C4::Context->dbh;
106	my $log_sql = "INSERT INTO import_oai (header_identifier, header_datestamp, header_status, metadata) VALUES (?, ?, ?, ?)";
107	my $log_sth = $log_dbh->prepare($log_sql);
108	$log_sth->execute($identifier_string,$datestamp_string,$status_string,$inxml);
109
110
111
112	#Filter the OAI-PMH record into a MARCXML record
113	my $metadata_xml;
114
115	#Source a default XSLT
116	my $htdocs = C4::Context->config('intrahtdocs');
117	my $theme = C4::Context->preference("template");
118	#FIXME: This doesn't work for UNIMARC!
119	my $xslfilename = "$htdocs/$theme/en/xslt/OAI2MARC21slim.xsl";
120
121	#FIXME: There's a better way to do these filters...
122	if ($filter){
123	my $filter_uri = URI->new($filter);
124	if ($filter_uri){
125	my $scheme = $filter_uri->scheme;
126	if ($scheme && $scheme eq "file"){
127	my $path = $filter_uri->path;
128	#Filters may theoretically be .xsl or .pm files
129	my($filename, $dirs, $suffix) = fileparse($path,(".xsl",".pm"));
130	if ($suffix && $suffix eq ".xsl"){
131	#If this new path exists, change the filter XSLT to it
132	if ( -f $path ){
133	$xslfilename = $path;
134	}
135	}
136	}
137	}
138	}
139
140	if ( -f $xslfilename ){
141	#FIXME: Ideally, it would be good to use Koha::XSLT_Handler here... (especially for persistent environments...)
142	my $xslt = XML::LibXSLT->new();
143	my $style_doc = XML::LibXML->load_xml(location => $xslfilename);
144	my $stylesheet = $xslt->parse_stylesheet($style_doc);
145	if ($stylesheet){
146	my $results = $stylesheet->transform($doc);
147	$metadata_xml = $stylesheet->output_as_bytes($results);
148	}
149	} else {
150	$result->{'status'} = "failed";
151	$result->{'error'} = "Metadata filter unavailable";
152	return $result;
153	}
154
155
156
157
158
159
160
161
162
163	#Import the MARCXML record into Koha
164	my $marcflavour = C4::Context->preference('marcflavour') \|\| 'MARC21';
165	my $marc_record = eval {MARC::Record::new_from_xml( $metadata_xml, "utf8", $marcflavour)};
166	if ($@) {
167	$result->{'status'} = "failed";
168	$result->{'error'} = $@;
169	return $result;
170	}
171
172	my $import_record_id = AddBiblioToBatch($batch_id, 0, $marc_record, "utf8", int(rand(99999)));
173	my @import_items_ids = AddItemsToImportBiblio($batch_id, $import_record_id, $marc_record, 'UPDATE COUNTS');
174
175	my $matcher = C4::Matcher->new($params->{record_type} \|\| 'biblio');
176	$matcher = C4::Matcher->fetch($params->{matcher_id});
177	my $number_of_matches = BatchFindDuplicates($batch_id, $matcher);
178
179	# XXX we are ignoring the result of this;
180	BatchCommitRecords($batch_id, $framework) if lc($import_mode) eq 'direct';
181
182	my $dbh = C4::Context->dbh();
183	my $sth = $dbh->prepare("SELECT matched_biblionumber FROM import_biblios WHERE import_record_id =?");
184	$sth->execute($import_record_id);
185	my $biblionumber=$sth->fetchrow_arrayref->[0] \|\| '';
186	$sth = $dbh->prepare("SELECT overlay_status FROM import_records WHERE import_record_id =?");
187	$sth->execute($import_record_id);
188	my $match_status = $sth->fetchrow_arrayref->[0] \|\| 'no_match';
189	my $url = 'http://'. C4::Context->preference('staffClientBaseURL') .'/cgi-bin/koha/catalogue/detail.pl?biblionumber='. $biblionumber;
190
191	$result->{'status'} = "ok";
192	$result->{'import_batch_id'} = $batch_id;
193	$result->{'match_status'} = $match_status;
194	$result->{'biblionumber'} = $biblionumber;
195	$result->{'url'} = $url;
196	return $result;
197	}