ACU/process/files/intradata_get.pl

#! /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 = (
    "defense" => {
	"update" => \&update_defense,
    },
    "grades" => {
	"new_bonus" => \&grades_new_bonus,
    },
    "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/";
    }

    return 0;
}


sub grades_new_bonus
{
    my $args = shift;

    my $project_id = $args->{param}{id};
    my $year = $args->{param}{year} // LDAP::get_year;

    if (! $project_id) {
	log ERROR, "No project_id given.";
	return "No project_id given";
    }

    if (! -e "$basedir/$year/$project_id/traces/") {
	mkdir "$basedir/$year/$project_id/traces/";
    }
    if (! -e "$basedir/$year/$project_id/traces/bonus/") {
	mkdir "$basedir/$year/$project_id/traces/bonus/";
    }

    for my $kfile (keys %{ $args->{files} })
    {
	log DEBUG, "Reading file $kfile";

	my $kbonus = $kfile;
	$kbonus =~ s/[^a-zA-Z0-9_-]/_/g;

	my @lines = split(/\n/, $args->{files}{$kfile});

	log TRACE, $args->{files}{$kfile};
	log TRACE, @lines;

	my $value = 1;
	# Looking for a global value 
	if ($lines[0] =~ /^(\d+)$/) {
	    $value = $1;
	    log INFO, "Setting global value to $value";
	    shift @lines;
	}

	for my $line (@lines)
	{
	    if ($line =~ /^([a-z0-9_-]+)(?:\s*:\s*(\d+))?$/)
	    {
		my $login = $1;
		my $tvalue = $2 // $value;
		my $trace;

		log DEBUG, "Applying bonus for $login:$tvalue";

		if (-e "$basedir/$year/$project_id/traces/bonus/$login.xml") {
		    open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!;
		    binmode $xml;
		    $trace = Trace->new($xml);
		    close $xml;
		}
		else {
		    $trace = Trace->new();
		}

		$trace->addId($kbonus, $tvalue);

		log DEBUG, "Updating $basedir/$year/$project_id/traces/bonus/$login.xml";

		open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!;
		print $xml $trace->toString();
		close $xml
	    }
	    else {
		log WARN, "Invalid login $line, line skiped";
	    }
	}
    }

    return "Ok";
}

sub update_defense
{
    my $args = shift;

    my $project_id = $args->{param}{id};
    my $year = $args->{param}{year} // LDAP::get_year;

    if (! $project_id) {
	log ERROR, "No project_id given.";
	return "No project_id given";
    }

    my $defense_id = $args->{param}{defense_id};

    if (! $defense_id) {
	log ERROR, "No defense_id given.";
	return "No defense_id given";
    }

    my $defense;
    if (exists $args->{files}{"$defense_id.xml"}) {
	$defense = $args->{files}{"$defense_id.xml"};
    }
    if (! $defense) {
	log ERROR, "Invalid $defense_id.xml received!";
	return "Invalid $defense_id.xml received!";
    }

    log INFO, "Update $year/$project_id/defenses/$defense_id.xml";

    if (! -e "$basedir/$year/$project_id/defenses/") {
	mkdir "$basedir/$year/$project_id/defenses/";
    }
    if (! -e "$basedir/$year/$project_id/traces/") {
	mkdir "$basedir/$year/$project_id/traces/";
    }
    if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") {
	mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/";
	my ($login, $pass, $uid, $gid) = getpwnam("www-data");
	chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/";
	chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/";
    }

    open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml";
    print $out $defense;
    close $out;

    return "Ok";
}

sub update_project
{
    my $args = shift;

    my $project_id = $args->{param}{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";

    return $_ if (create_tree($year, $project_id));

    open my $out, ">", "$basedir/$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 "Unknown action '$action' for $type.";
    }

    return $actions{$type}{$action}($args);
}

Process::register("intradata_get", \&process_get);