Add new process to receive files to intradata

process/files/intradata_get.pl

@@ -0,0 +1,92 @@
+#! /usr/bin/env perl
+
+use v5.10.1;
+use strict;
+use warnings;
+use Pod::Usage;
+
+use lib "../../";
+
+use ACU::Log;
+use ACU::LDAP;
+use ACU::Process;
+
+our $basedir = "/intradata";
+
+my %actions = (
+    "project" => {
+	"create" => \&update_project,
+	"update" => \&update_project,
+	"delete" => \&delete_project,
+    }
+);
+
+sub create_tree($$)
+{
+    my $year = shift;
+    my $project_id = shift;
+
+    if (! -d "$basedir/$year/") {
+	log ERROR, "No directory for year $year. Ask a root to create it.";
+	return "No directory for year $year. Ask a root to create it.";
+    }
+
+    if (! -e "$basedir/$year/$project_id/") {
+	mkdir "$basedir/$year/$project_id/";
+    }
+}
+
+
+sub update_project
+{
+    my $args = shift;
+
+    my $project_id = $args->{param}{project_id};
+    my $year = $args->{param}{year} // LDAP::get_year;
+
+    if (! $project_id) {
+	log ERROR, "No project_id given.";
+	return "No project_id given";
+    }
+
+    my $butler;
+    if (exists $args->{files}{"butler.xml"}) {
+	$butler = $args->{files}{"butler.xml"};
+    }
+    if (! $butler) {
+	log ERROR, "Invalid butler.xml received!";
+	return "Invalid butler.xml received!";
+    }
+
+    log INFO, "Update $year/$project_id/butler.xml";
+
+    create_tree($project_id, $year);
+
+    open my $out, ">", "$year/$project_id/butler.xml";
+    print $out $butler;
+    close $out;
+
+    return "Ok";
+}
+
+sub delete_project
+{
+    log WARN, "delete_project: not implemented."
+}
+
+
+sub process_get
+{
+    my ($given_args, $args) = @_;
+
+    my $type = $args->{param}{type};
+    my $action = $args->{param}{action} // "update";
+
+    if (! exists $actions{$type}{$action}) {
+	log WARN, "Unknown action '$action' for $type.";
+    }
+
+    return $node_actions{$type}{$action}($args);
+}
+
+Process::register("intradata_get", \&process_get);