Compare commits
1 commit
master
...
splited_in
| Author | SHA1 | Date | |
|---|---|---|---|
|
bd7c4d9e6e |
4 changed files with 335 additions and 298 deletions
|
|
@ -6,15 +6,18 @@ use warnings;
|
|||
use Carp;
|
||||
use Pod::Usage;
|
||||
|
||||
use lib "../../";
|
||||
|
||||
use ACU::Config;
|
||||
use ACU::Log;
|
||||
use ACU::LDAP;
|
||||
use ACU::Grading;
|
||||
use ACU::Process;
|
||||
use ACU::Trace;
|
||||
|
||||
our $basedir = "/intradata";
|
||||
use intradata_get::defense;
|
||||
use intradata_get::grades;
|
||||
use intradata_get::project;
|
||||
|
||||
our $intradata;
|
||||
|
||||
my %actions = (
|
||||
"defense" => {
|
||||
|
|
@ -28,304 +31,12 @@ my %actions = (
|
|||
"create" => \&update_project,
|
||||
"update" => \&update_project,
|
||||
"delete" => \&delete_project,
|
||||
},
|
||||
"traces" => {
|
||||
"update" => \&update_trace,
|
||||
}
|
||||
);
|
||||
|
||||
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_generate
|
||||
{
|
||||
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/grades/") {
|
||||
mkdir "$basedir/$year/$project_id/grades/";
|
||||
}
|
||||
|
||||
log DEBUG, "Generate list of students";
|
||||
|
||||
# Create list of students to generate
|
||||
my @logins;
|
||||
if ($args->{unamed})
|
||||
{
|
||||
for (my $i = $args->{unamed}; $i > 0; $i--) {
|
||||
push @logins, $args->{param}{$i};
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!";
|
||||
for my $dir (grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh))
|
||||
{
|
||||
opendir(my $dhm, "$basedir/$year/$project_id/traces/$dir") or croak "can't opendir $basedir/$year/$project_id/traces/$dir: $!";
|
||||
|
||||
for my $login (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/traces/$dir/$_" } readdir($dhm))
|
||||
{
|
||||
$login =~ s/\.xml$//;
|
||||
if (! grep { /^\Q$login\E$/ } @logins) {
|
||||
push @logins, $login;
|
||||
}
|
||||
}
|
||||
|
||||
closedir $dhm;
|
||||
}
|
||||
closedir $dh;
|
||||
}
|
||||
|
||||
log TRACE, @logins;
|
||||
|
||||
# Load grading file
|
||||
my $grading;
|
||||
if (exists $args->{files}{"grading.xml"}) {
|
||||
$grading = $args->{files}{"grading.xml"};
|
||||
}
|
||||
if (! $grading) {
|
||||
log ERROR, "Invalid grading.xml received!";
|
||||
return "Invalid grading.xml received!";
|
||||
}
|
||||
|
||||
$grading = Grading->new($grading);
|
||||
|
||||
opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!";
|
||||
my @trace_dirs = grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh);
|
||||
closedir $dh;
|
||||
|
||||
for my $login (@logins)
|
||||
{
|
||||
log DEBUG, "Generating grades for $login";
|
||||
for my $dir (@trace_dirs)
|
||||
{
|
||||
log DEBUG, "Generating grades from $dir";
|
||||
if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml")
|
||||
{
|
||||
open my $xmltrace, "<", "$basedir/$year/$project_id/traces/$dir/$login.xml" or croak "traces/$dir/$login.xml: $!";
|
||||
binmode $xmltrace;
|
||||
my $trace = Trace->new($xmltrace);
|
||||
close $xmltrace;
|
||||
|
||||
log DEBUG, "Fill from file: traces/$dir/$login.xml";
|
||||
log TRACE, $trace->getIds;
|
||||
|
||||
$grading->fill($trace->getIds);
|
||||
}
|
||||
}
|
||||
|
||||
log DEBUG, "Computed grades: ".$grading->compute($login);
|
||||
|
||||
open my $xmlgrade, ">", "$basedir/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml";
|
||||
binmode $xmlgrade;
|
||||
print $xmlgrade $grading->computeXML($login);
|
||||
close $xmlgrade;
|
||||
|
||||
$grading->reset();
|
||||
}
|
||||
|
||||
return "Ok";
|
||||
}
|
||||
|
||||
sub grades_new_bonus
|
||||
{
|
||||
my $args = shift;
|
||||
|
||||
my $project_id = $args->{param}{id};
|
||||
my $delete = $args->{param}{delete};
|
||||
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;
|
||||
$value = 1 if (!$delete);
|
||||
|
||||
# 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*([0-9.]+))?$/)
|
||||
{
|
||||
my $login = $1;
|
||||
my $tvalue = $2 // $value;
|
||||
my $trace;
|
||||
|
||||
if ($delete) {
|
||||
log DEBUG, "Deleting bonus for $login";
|
||||
} else {
|
||||
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;
|
||||
}
|
||||
elsif ($delete) {
|
||||
next;
|
||||
}
|
||||
else {
|
||||
$trace = Trace->new();
|
||||
}
|
||||
|
||||
if ($delete) {
|
||||
if ($tvalue && $tvalue == $trace->getIds($kbonus)) {
|
||||
$trace->delId($kbonus);
|
||||
} else {
|
||||
$trace->delId($kbonus);
|
||||
}
|
||||
} else {
|
||||
$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
|
||||
|
|
|
|||
58
process/files/intradata_get/defense.pm
Normal file
58
process/files/intradata_get/defense.pm
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
use ACU::LDAP;
|
||||
|
||||
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 "$main::intradata/$year/$project_id/defenses/") {
|
||||
mkdir "$main::intradata/$year/$project_id/defenses/";
|
||||
}
|
||||
if (! -e "$main::intradata/$year/$project_id/traces/") {
|
||||
mkdir "$main::intradata/$year/$project_id/traces/";
|
||||
}
|
||||
if (! -e "$main::intradata/$year/$project_id/traces/defense_$defense_id/") {
|
||||
mkdir "$main::intradata/$year/$project_id/traces/defense_$defense_id/";
|
||||
my ($login, $pass, $uid, $gid) = getpwnam("www-data");
|
||||
chown $uid, $gid, "$main::intradata/$year/$project_id/traces/defense_$defense_id/";
|
||||
chmod 0775, "$main::intradata/$year/$project_id/traces/defense_$defense_id/";
|
||||
}
|
||||
|
||||
open my $out, ">", "$main::intradata/$year/$project_id/defenses/$defense_id.xml";
|
||||
print $out $defense;
|
||||
close $out;
|
||||
|
||||
return "Ok";
|
||||
}
|
||||
|
||||
1;
|
||||
203
process/files/intradata_get/grades.pm
Normal file
203
process/files/intradata_get/grades.pm
Normal file
|
|
@ -0,0 +1,203 @@
|
|||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
use ACU::Config;
|
||||
use ACU::LDAP;
|
||||
use ACU::Log;
|
||||
|
||||
# Function to generate student grades
|
||||
sub grades_generate
|
||||
{
|
||||
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 "$main::intradata/$year/$project_id/grades/") {
|
||||
mkdir "$main::intradata/$year/$project_id/grades/";
|
||||
}
|
||||
|
||||
log DEBUG, "Generate list of students";
|
||||
|
||||
# Create list of students to generate
|
||||
my @logins;
|
||||
if ($args->{unamed})
|
||||
{
|
||||
for (my $i = $args->{unamed}; $i > 0; $i--) {
|
||||
push @logins, $args->{param}{$i};
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
opendir(my $dh, "$main::intradata/$year/$project_id/traces/") or croak "can't opendir $main::intradata/$year/$project_id/traces/: $!";
|
||||
for my $dir (grep { ( ! /^\./ ) && -d "$main::intradata/$year/$project_id/traces/$_" } readdir($dh))
|
||||
{
|
||||
opendir(my $dhm, "$main::intradata/$year/$project_id/traces/$dir") or croak "can't opendir $main::intradata/$year/$project_id/traces/$dir: $!";
|
||||
|
||||
for my $login (grep { ( ! /^\./ ) && -f "$main::intradata/$year/$project_id/traces/$dir/$_" } readdir($dhm))
|
||||
{
|
||||
$login =~ s/\.xml$//;
|
||||
if (! grep { /^\Q$login\E$/ } @logins) {
|
||||
push @logins, $login;
|
||||
}
|
||||
}
|
||||
|
||||
closedir $dhm;
|
||||
}
|
||||
closedir $dh;
|
||||
}
|
||||
|
||||
log TRACE, @logins;
|
||||
|
||||
# Load grading file
|
||||
my $grading;
|
||||
if (exists $args->{files}{"grading.xml"}) {
|
||||
$grading = $args->{files}{"grading.xml"};
|
||||
}
|
||||
if (! $grading) {
|
||||
log ERROR, "Invalid grading.xml received!";
|
||||
return "Invalid grading.xml received!";
|
||||
}
|
||||
|
||||
$grading = Grading->new($grading);
|
||||
|
||||
opendir(my $dh, "$main::intradata/$year/$project_id/traces/") or croak "can't opendir $main::intradata/$year/$project_id/traces/: $!";
|
||||
my @trace_dirs = grep { ( ! /^\./ ) && -d "$main::intradata/$year/$project_id/traces/$_" } readdir($dh);
|
||||
closedir $dh;
|
||||
|
||||
for my $login (@logins)
|
||||
{
|
||||
log DEBUG, "Generating grades for $login";
|
||||
for my $dir (@trace_dirs)
|
||||
{
|
||||
log DEBUG, "Generating grades from $dir";
|
||||
if (-f "$main::intradata/$year/$project_id/traces/$dir/$login.xml")
|
||||
{
|
||||
open my $xmltrace, "<", "$main::intradata/$year/$project_id/traces/$dir/$login.xml" or croak "traces/$dir/$login.xml: $!";
|
||||
binmode $xmltrace;
|
||||
my $trace = Trace->new($xmltrace);
|
||||
close $xmltrace;
|
||||
|
||||
log DEBUG, "Fill from file: traces/$dir/$login.xml";
|
||||
log TRACE, $trace->getIds;
|
||||
|
||||
$grading->fill($trace->getIds);
|
||||
}
|
||||
}
|
||||
|
||||
log DEBUG, "Computed grades: ".$grading->compute($login);
|
||||
|
||||
open my $xmlgrade, ">", "$main::intradata/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml";
|
||||
binmode $xmlgrade;
|
||||
print $xmlgrade $grading->computeXML($login);
|
||||
close $xmlgrade;
|
||||
|
||||
$grading->reset();
|
||||
}
|
||||
|
||||
return "Ok";
|
||||
}
|
||||
|
||||
|
||||
sub grades_new_bonus
|
||||
{
|
||||
my $args = shift;
|
||||
|
||||
my $project_id = $args->{param}{id};
|
||||
my $delete = $args->{param}{delete};
|
||||
my $year = $args->{param}{year} // LDAP::get_year;
|
||||
|
||||
if (! $project_id) {
|
||||
log ERROR, "No project_id given.";
|
||||
return "No project_id given";
|
||||
}
|
||||
|
||||
if (! -e "$main::intradata/$year/$project_id/traces/") {
|
||||
mkdir "$main::intradata/$year/$project_id/traces/";
|
||||
}
|
||||
if (! -e "$main::intradata/$year/$project_id/traces/bonus/") {
|
||||
mkdir "$main::intradata/$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;
|
||||
$value = 1 if (!$delete);
|
||||
|
||||
# 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*([0-9.]+))?$/)
|
||||
{
|
||||
my $login = $1;
|
||||
my $tvalue = $2 // $value;
|
||||
my $trace;
|
||||
|
||||
if ($delete) {
|
||||
log DEBUG, "Deleting bonus for $login";
|
||||
} else {
|
||||
log DEBUG, "Applying bonus for $login:$tvalue";
|
||||
}
|
||||
|
||||
if (-e "$main::intradata/$year/$project_id/traces/bonus/$login.xml") {
|
||||
open my $xml, "<", "$main::intradata/$year/$project_id/traces/bonus/$login.xml" or croak $!;
|
||||
binmode $xml;
|
||||
$trace = Trace->new($xml);
|
||||
close $xml;
|
||||
}
|
||||
elsif ($delete) {
|
||||
next;
|
||||
}
|
||||
else {
|
||||
$trace = Trace->new();
|
||||
}
|
||||
|
||||
if ($delete) {
|
||||
if ($tvalue && $tvalue == $trace->getIds($kbonus)) {
|
||||
$trace->delId($kbonus);
|
||||
} else {
|
||||
$trace->delId($kbonus);
|
||||
}
|
||||
} else {
|
||||
$trace->addId($kbonus, $tvalue);
|
||||
}
|
||||
|
||||
log DEBUG, "Updating $main::intradata/$year/$project_id/traces/bonus/$login.xml";
|
||||
|
||||
open my $xml, ">", "$main::intradata/$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";
|
||||
}
|
||||
|
||||
1;
|
||||
65
process/files/intradata_get/project.pm
Normal file
65
process/files/intradata_get/project.pm
Normal file
|
|
@ -0,0 +1,65 @@
|
|||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
use ACU::Config;
|
||||
use ACU::LDAP;
|
||||
use ACU::Log;
|
||||
|
||||
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, ">", "$main::intradata/$year/$project_id/butler.xml";
|
||||
print $out $butler;
|
||||
close $out;
|
||||
|
||||
return "Ok";
|
||||
}
|
||||
|
||||
|
||||
sub delete_project
|
||||
{
|
||||
log WARN, "delete_project: not implemented."
|
||||
}
|
||||
|
||||
|
||||
sub create_tree($$)
|
||||
{
|
||||
my $year = shift;
|
||||
my $project_id = shift;
|
||||
|
||||
if (! -d "$main::intradata/$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.";
|
||||
}
|
||||
|
||||
mkdir "$main::intradata/$year/$project_id/" if (! -e "$main::intradata/$year/$project_id/");
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in a new issue