#! /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 = ($args->{files}{$kfile} =~ tr/\n//); log TRACE, $args->{files}{$kfile}; my $value = 1; # Looking for a global value if ($lines[0] =~ /^(\d+)$/) { $value = $1; log INFO, "Setting global value to $value"; shift @lines; } log TRACE, @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);