Responsabilità | Ultima modifica | Visualizza Log | feed RSS
<%perl>
# ============================================================================== Uses
# ============================================================================== createCmd
sub DBIconnectAndBeginTransaction {
# $dbhandler = DBI->connect([[DB_StrConnect]]) or die $DBI::strerr;
# $dbhandler->{AutoCommit} = 1; # Shure to be in On, before call begin_work that set it off
# $dbhandler->{RaiseError} = 1;
# $dbhandler->begin_work or $m->out( "DBI Error begin_work: ".$DBI::errstr."\n");
}
# ============================================================================== createCmd
sub createCmd {
my($errcmd, $strcmd, $args) = @_;
my $ret;
my $message = "$strcmd $args";
my $curfunc = '5';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
# ==================================================================== share
if ($strcmd eq 'share'){
# Called by FR_teacher/FM_control/class.html - for control the current class Share
my ($classid, $status) = split /:/, $args;
if ($status =~ m/[[class_status_active]]/){
$ret = updateFieldData('xx', 'class', 'permision', 'where id=?', $classid, 'insertFM', '[[usr_permision_SH]]');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return(checkExec($curfunc, "su1 cms_command enableshare $classid"));
}else{
$ret = updateFieldData('xx', 'class', 'permision', 'where id=?', $classid, 'deleteFM', '[[usr_permision_SH]]');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return(checkExec($curfunc, "su1 cms_command disableshare $classid"));
}
# ==================================================================== webusr
}elsif ($strcmd eq 'webusr'){
# Called by FR_teacher/FM_control/pc.html - for control the current student with the usrid
my ($classid, $permision, $usrid) = split /:/, $args;
my ($keyvalue, $value);
$ret = updateUsrClassRecord($classid, $usrid, $permision); #set USRCLASS fields: permision
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
# this must be change , because the previus line must be done for this one to be good !!!!
$value = getEnableUsrOfClass($classid, '%[[usr_permision_WW]]%');
$ret = updateClassKeys("Class_$classid", $value);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
# For delete after been checked
if ($permision =~ m/[[usr_permision_SH]]/){
# # if is select in pc.html: share or share and internet
$ret = sambaControlClass($classid, '[[class_status_active]]', $usrid); #set permision 770 to dir class
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}else{
# # if is select in pc.html: nessuna or internet
$ret = sambaControlClass($classid, '[[class_status_suspend]]', $usrid); #set permision 700 to dir class
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}
return($ret);
# ==================================================================== web
}elsif ($strcmd eq 'web'){
# Called by FR_teacher/FM_control/class.html - for control the current class Internet Access
my ($classid, $status) = split /:/, $args;
if ($status =~ m/[[class_status_active]]/){
my $value = getEnableUsrOfClass($classid, '%[[usr_permision_WW]]%');
$ret = updateClassKeys("Class_$classid", $value);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = updateFieldData('xx', 'class', 'permision', 'where id=?', $classid, 'insertFM', '[[usr_permision_WW]]');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}else{
$ret = updateClassKeys("Class_$classid", '');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = updateFieldData('xx', 'class', 'permision', 'where id=?', $classid, 'deleteFM', '[[usr_permision_WW]]');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}
return($ret);
# ==================================================================== fm
}elsif ($strcmd eq 'fm'){
# Called by FR_teacher/FM_control/class.html - for control the current class FM
my ($classid, $status) = split /:/, $args;
if ($status =~ m/[[class_status_active]]/){
my $sitefm = getField('class', 'sitefm', 'where id=?', $classid);
$ret = updateField1('keys', 'value', 'where key=?', "FM_$classid", $sitefm);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = updateFieldData('xx', 'class', 'permision', 'where id=?', $classid, 'insertFM', 'fm');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}else{
$ret = saveFM($classid); #set sitefm field = FM_$classid KEYS field
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = updateField1('keys', 'value', 'where key=?', "FM_$classid", '');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = updateFieldData('xx', 'class', 'permision', 'where id=?', $classid, 'deleteFM', 'fm');
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}
# =================== add or delete 'FM' depending of $status
$ret = updateFieldData('xx', 'keys','value','where key=?',"ClassList",'updateClassFlag',"$classid:$status:FM");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
checkExec($curfunc, "su1 HUP_squid_redirect");
return($ret);
# ==================================================================== class
}elsif ($strcmd eq 'class'){
# === we has to enable all the users of the class, that have permision
my ($classid, $status) = split /:/, $args;
my $teacherid = getCurrentUsrid();
my $usrid = getEnableStudentOfClass($classid);
my $classpermision = getField('class', 'permision', 'where id=?', $classid);
if ($status =~ m/[[class_status_active]]/){
$ret = updateClassRecord($classid, $status); #set CLASS fields: ipteacher,status
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
if($classpermision =~ m/[[class_permision_YI]]/ ){
$ret = insertIntoKeys($classid, $teacherid); #new KEYS records: ClassList,Class,OkAuth,NoAuth,FM
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}
$ret = sambaControlClass($classid, $status, $usrid); #set permision 770 to dir class and enableuser students
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
#$m->out( "ret=$ret \n");
}else{
$ret = sambaControlClass($classid, $status, $usrid); #set permision 700 to dir class and disable students
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
if($classpermision =~ m/[[class_permision_YI]]/ ){
$ret = saveFM($classid); #set sitefm field = FM_$classid KEYS field
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteFromKeys($classid); #clear KEYS records: ClassList,Class,OkAuth,NoAuth,FM
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}
$ret = updateClassRecord($classid, $status); #set CLASS fields: ipteacher,status
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}
return($ret);
# ==================================================================== enablevipiusr
}elsif ($strcmd eq 'enablevipusr'){
# the $args = usrid
# DBIconnectAndBeginTransaction();
eval {
$ret = insertVipIntoKeys($args); #new KEYS records: OkUserList
# $dbhandler->commit; # commit the changes if we get this far
# $dbhandler->{AutoCommit} = 0; # Shure to be in On, before call begin_work that set it off
};
if ($@) {
writeMsg($message . $ret, $curfunc);
$m->out( "Transaction aborted because $@");
# $dbhandler->rollback; # undo the incomplete changes
# add other application on-error-clean-up code here
}
return($ret);
# ==================================================================== disablevipiusr
}elsif ($strcmd eq 'disablevipusr'){
# the $args = usrid
return(deleteVipFromKeys($args)); #clear KEYS records: OkUserList
# ==================================================================== enableusr
}elsif ($strcmd eq 'enableusr'){
# the $args = classId
return(checkExec($curfunc, "su1 cms_command enableuser $args"));
# ==================================================================== enableusrshare
}elsif ($strcmd eq 'enableusrshare'){
# the $args = classId
return(checkExec($curfunc, "su1 cms_command enableuser $args"));
# ==================================================================== disableusrshare
}elsif ($strcmd eq 'disableusrshare'){
# the $args = classId
return(checkExec($curfunc, "su1 cms_command disableuser $args"));
# ==================================================================== createclass
}elsif ($strcmd eq 'createclass' or $strcmd eq 'updateclass'){
# updateclass <classid> [-teacher <id> <id> <id> ...] [-student <id> <id> <id> ...]
return(checkExec($curfunc, "su1 cms_command updateclass $args"));
# ==================================================================== deleteclass
}elsif ($strcmd eq 'deleteclass'){
# deleteclass <classid> [-all] <id> <id> <id>
return(checkExec($curfunc, "su1 cms_command deleteclass $args"));
# ==================================================================== createusr
}elsif ($strcmd eq 'createusr'){
# newuser <id> <password> [<type>]
return(checkExec($curfunc, "su1 cms_command newuser $args"));
# ==================================================================== refreshredirect
}elsif ($strcmd eq 'refreshredirect'){
# newuser <id> <password> [<type>]
return(checkExec($curfunc, "su1 HUP_squid_redirect"));
# ==================================================================== logout of TB_layout
}elsif ($strcmd eq 'logout'){
# Called from FR_teacher/MN_menuTeacher - we have to check the status class
my $classid = $args;
$resultPageReturnValue = 'TRUE';
$ret = 'OK';
return($ret);
# ==================================================================== delete usr FM_student
}elsif ($strcmd eq 'fm_student'){
# Called from FM_student - we have to delete the usr
my $usrid = $args;
$ret = deleteRecord('usrclass', "where usrid=? and profile='[[usr_profile_student]]'", $usrid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteRecord('usr', 'where id=?', $usrid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteVipFromKeys($usrid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = checkExec($curfunc, "su1 cms_command deluser $usrid");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return($ret);
# ==================================================================== delete class F2_class
}elsif ($strcmd eq 'f2_class'){
# Called from F2_class - we have to delete the class
my $classid = $args;
# if(countUsrClass($classid) == 0){
if(1){
my $listusr = getAllUsrOfClass($classid);
$ret = deleteRecord('usrclass', "where classid=?", $classid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteRecord('class', 'where id=?', $classid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = checkExec($curfunc, "su1 cms_command deleteclass $classid -all $listusr");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
}else{
$ret = '';
$errcmd = ' Class not empty';
writeMsg($message . $errcmd, $dbgerror . $curfunc);
}
return($ret);
# ==================================================================== error case if blank
}elsif ($strcmd eq ''){
$errcmd = 'blank checking';
writeMsg($message . $errcmd.'blank command unknow ', $dbgerror . $curfunc);
return('');
# ==================================================================== error case if default
}else{
$errcmd = 'checking';
writeMsg($message . $errcmd.'command unknow ', $dbgerror . $curfunc);
return('');
}
}
# ============================================================================== checkExec
sub XcheckExec($$) {
my $caller = shift;
my($cmd) = @_;
#### $s - status, $o - stdout, $r stderr
my($s, $o, $r) = Esecuzione(2, $cmd);
my $ret = '';
my $message;
my $curfunc = ',4';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
if ($s eq '0'){ ### No errors
chomp($o);
$ret = 'OK_'.$o;
$message = "in CheckExec, cmd= @_ out=$ret";
writeMsg($message, $dbginfo . $caller. $curfunc);
}elsif ($s eq '1'){ ### Error
$message = "Error on @_, status=$s, out=$o, err=$r";
writeMsg($message, $dbgerror . $caller. $curfunc);
}elsif ($s eq '-1'){ ### Time out
$message = "Time out on @_, status=$s, out=$o, err=$r";
writeMsg($message, $dbgerror . $caller. $curfunc);
}else{ ### Error Number > 1 on exit
$message = "Error on @_, status=$s, out=$o, err=$r";
writeMsg($message, $dbgerror . $caller. $curfunc);
}
return $ret;
}
# ============================================================================== countUsrClass
sub countUsrClass($){
my ($classid) = @_;
my $dbh = $m->comp('dbconnect');
my $sth;
my $ret;
my $tablename = 'usrclass';
my $curSQL;
my $value = -1;
my $curfunc = '20';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = 'OK';
$curSQL = "select count(*) from $tablename where classid=?";
#$m->out($curSQL);
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute($classid);
$value = $sth->fetchrow_array;
if (! $ret){
$message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
}
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return($value);
}
# ============================================================================== updateUsrClassRecord
sub updateUsrClassRecord($$$){
my ($classid, $usrid, $permision) = @_;
my $dbh = $m->comp('dbconnect');
my $sth;
my $ret;
my $tablename = 'usrclass';
my $curSQL;
my $curfunc = '21';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = 'OK';
$curSQL = "update $tablename set permision=? where usrid=? and classid=?";
#$m->out($curSQL);
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute($permision, $usrid, $classid);
if (! $ret){
$message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
}
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return($ret);
}
# ============================================================================== updateClassRecord
sub updateClassRecord($$){
my ($classid, $status) = @_;
my $dbh = $m->comp('dbconnect');
# $dbhandler = DBI->connect([[DB_StrConnect]]) or die $DBI::strerr;
# my $dbh = $dbhandler;
my $sth;
my $ret;
my $tablename = 'class';
my $curSQL;
my $remoteIp;
my $curfunc = '22';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = 'OK';
if ($status eq '[[class_status_active]]'){
if(%ENV->{'HTTP_X_FORWARDED_FOR'}){
$remoteIp= %ENV->{'HTTP_X_FORWARDED_FOR'};
}else{
$remoteIp= %ENV->{'REMOTE_ADDR'};
}
}else{
$remoteIp = '';
}
$curSQL = "update $tablename set status=?, ipteacher=? where id=?";
#$m->out($curSQL);
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute($status, $remoteIp, $classid);
if (! $ret){
$message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
}
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return($ret);
}
# ============================================================================== saveFM
sub saveFM($){
my ($classid) = @_;
my $dbh = $m->comp('dbconnect');
my $sth;
my $ret;
my $tablename;
my $curSQL;
my $key;
my $value;
my $curfunc = '23';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = 'OK';
$tablename = 'keys';
$key = "FM_$classid";
$curSQL = "select value from $tablename where key=?";
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute($key);
if (! $ret){
$message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
}
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$value = $sth->fetchrow_array;
$tablename = 'class';
$curSQL = "update $tablename set sitefm=? where id=?";
#$m->out( $curSQL);
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute($value, $classid);
if (! $ret){
$message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
}
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return($ret);
}
# ============================================================================== updateClassKeys
sub updateClassKeys($$){
my ($keyvalue, $value) = @_;
my $ret;
my $curfunc = '24';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
$ret = updateField1('keys', 'value', 'where key=?', $keyvalue, $value);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
# ============= Make the changes visible
$ret = checkExec($curfunc, "su1 HUP_squid_redirect");
return($ret);
}
# ============================================================================== insertIntoKeys
sub insertIntoKeys($$){
my ($classid, $teacherid) = @_;
my $keyvalue;
my $value;
my $ret;
my $curfunc = '25';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
$ret = updateFieldData('xx', 'keys', 'value', 'where key=?', 'ClassList', 'insertClass', "$classid:$teacherid:");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$keyvalue = 'Class_' . $classid;
$ret = insertRecord('keys', "(id,key,value) values (nextval('keys_id'), '$keyvalue', '')");
$value = getEnableUsrOfClass($classid, '%[[usr_permision_WW]]%');
$ret = updateField1('keys', 'value', 'where key=?', $keyvalue, $value);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$keyvalue = 'FM_' . $classid;
$ret = insertRecord('keys', "(id,key,value) values (nextval('keys_id'), '$keyvalue', '')");
$value = getField('class', 'sitefm', 'where id=?', $classid);
#$m->out($value);
$ret = updateField1('keys', 'value', 'where key=?', $keyvalue, $value);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$keyvalue = 'OkAuth_' . $classid;
$ret = insertRecord('keys', "(id,key,value) values (nextval('keys_id'), '$keyvalue', '')");
$value = getField('class', 'siteok', 'where id=?', $classid);
$ret = updateField1('keys', 'value', 'where key=?', $keyvalue, $value);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$keyvalue = 'NoAuth_' . $classid;
$ret = insertRecord('keys', "(id,key,value) values (nextval('keys_id'), '$keyvalue', '')");
$value = getField('class', 'sitebad', 'where id=?', $classid);
$ret = updateField1('keys', 'value', 'where key=?', $keyvalue, $value);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
# ============= Make the changes visible
$ret = checkExec($curfunc, "su1 HUP_squid_redirect");
return($ret);
}
# ============================================================================== deleteFromKeys
sub deleteFromKeys($){
my ($classid) = @_;
my $ret;
my $curfunc = '26';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
$ret = updateFieldData('xx', 'keys', 'value', 'where key=?', 'ClassList', 'deleteClass', $classid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteRecord('keys', 'where key=?', "Class_$classid");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteRecord('keys', 'where key=?', "FM_$classid");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteRecord('keys', 'where key=?', "OkAuth_$classid");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
$ret = deleteRecord('keys', 'where key=?', "NoAuth_$classid");
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
# ============= Make the changes visible
$ret = checkExec($curfunc, "su1 HUP_squid_redirect");
return($ret);
}
# ============================================================================== deleteFromKeys
sub insertVipIntoKeys($){
my ($usrid) = @_;
my $ret;
my $curfunc = '27';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
$ret = updateFieldData('xx', 'keys', 'value', 'where key=?', 'OkUserList', 'insertVipUsr', $usrid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
# ============= Make the changes visible
$ret = checkExec($curfunc, "su1 HUP_squid_redirect");
return($ret);
}
# ============================================================================== deleteFromKeys
sub deleteVipFromKeys($){
my ($usrid) = @_;
my $ret;
my $curfunc = '28';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
$ret = updateFieldData('xx', 'keys', 'value', 'where key=?', 'OkUserList', 'deleteVipUsr', $usrid);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
# ============= Make the changes visible
$ret = checkExec($curfunc, "su1 HUP_squid_redirect");
return($ret);
}
# ============================================================================== ADUkeysValues
sub ADUkeysValue($$$){
my ($function, $value, $newitemvalue) = @_;
my $retvalue = '';
my $found = '';
my $firstime = 'TRUE';
my ($newname, $newteacher, $newflag) = split /:/, $newitemvalue;
my @classes = split /\s+/, $value;
my $curfunc = '33';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
# ========================== Process all the active classes, [$classid:$teacherid:$flag] ...
foreach my $curclass ( @classes ){
my ($name, $teacher, $flag) = split /:/, $curclass;
if( $name =~ m/$newname/ ){
$found = 'TRUE';
if($function eq 'ADD_FLAG' ){
if($flag !~ m/$newflag/){
$flag .= $newflag;
}
if($newteacher ne '_PREV_VALUE_'){
$teacher = $newteacher;
}
$curclass = "$name:$teacher:$flag";
}elsif($function eq 'DELETE_FLAG'){
$flag =~ s/$newflag//;
if($newteacher ne '_PREV_VALUE_'){
$teacher =~ s/$newteacher//;
}
$curclass = "$name:$teacher:$flag";
}elsif($function eq 'DELETE'){
$curclass = '';
}else{
$message = "Error: function:$function unknown\n";
writeMsg($message, $dbgerror . $curfunc);
}
}
if($firstime){
$retvalue = $curclass;
$firstime = '';
}else{
$retvalue .= ' ' . $curclass;
}
}
if(! $found ){
$message = "Error: flag:$newflag didn't find on keys\n";
writeMsg($message, $dbgerror . $curfunc);
}
return($retvalue);
}
# ============================================================================== updateDbField
sub updateFieldData($$$$$$$){
my ($dummy, $tbname, $field, $condition, $conditionvalue, $function, $functionargs) = @_;
my $dbh = $m->comp('dbconnect');
my $sth;
my $ret;
my $tablename = $tbname;
my $curSQL;
my $key;
my $value;
my $newvalue;
my $curfunc = '34';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
# ==================================================== Get the value to update
$curSQL = "select $field from $tablename $condition";
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute($conditionvalue);
if (! $ret){
$message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
}
$value = $sth->fetchrow_array;
#$m->out("value:$value");
# ==================================================== Process the value with function
if($function eq 'deleteClass'){
my $classid = $functionargs;
$newvalue = ADUkeysValue('DELETE', $value, "$classid:_PREV_VALUE_:_PREV_VALUE");
}elsif($function eq 'insertVipUsr'){
my $usrid = $functionargs;
$newvalue = $value;
if($value !~ m/$usrid/){
$newvalue = $value . " $usrid";
}
}elsif($function eq 'deleteVipUsr'){
my $usrid = $functionargs;
$newvalue = $value;
if($value =~ m/$usrid/){
$newvalue =~ s/$usrid//;
}
}elsif($function eq 'deleteFM'){
my $fm = $functionargs;
$newvalue = $value;
if($value =~ m/$fm/){
$newvalue =~ s/\s*$fm//;
}
}elsif($function eq 'insertFM'){
chomp($value);
$newvalue = $value . "$functionargs";
}elsif($function eq 'insertClass'){
$newvalue = $value . " $functionargs";
}elsif($function eq 'updateClass'){
$newvalue = $value . " $functionargs";
}elsif($function eq 'updateClassFlag'){
my ($classid, $status, $newflag) = split /:/, $functionargs;
#$m->out(Dumper($functionargs));
if($status =~ m/[[class_status_active]]/ ){
$newvalue = ADUkeysValue('ADD_FLAG', $value, "$classid:_PREV_VALUE_:$newflag");
}else{
$newvalue = ADUkeysValue('DELETE_FLAG', $value, "$classid:_PREV_VALUE_:$newflag");
}
}else{
$message = "Error:rich case default on $function";
writeMsg($message, $dbgerror . $curfunc);
}
# ==================================================== Process the value with function
if($tablename eq 'keys'){
$curSQL = "update $tablename set id=nextval('keys_id'), $field=? $condition";
}else{
$curSQL = "update $tablename set $field=? $condition";
}
#$m->out( $curSQL);
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute($newvalue, $conditionvalue);
if (! $ret){
$message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
}
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return($ret);
}
# ============================================================================== sambaControlClass
sub sambaControlClass($$$){
my ($classid, $status, $usrid) = @_;
my $ret;
my $cmd;
my $curfunc = '35';
my $dbginfo = ' 40:';
my $dbgerror = ' 1:';
my $message = '';
my $listusr = $usrid;
if ($status eq '[[class_status_active]]'){
$cmd = "su1 cms_command enableclass $classid $listusr";
}else{
$cmd = "su1 cms_command disableclass $classid $listusr";
}
$ret = checkExec($curfunc, $cmd);
writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);
return($ret);
}
# ============================================================================== getAllUsrOfClass
sub getAllUsrOfClass($){
my ($classid) = @_;
my $dbh = $m->comp('dbconnect');
my $curSQL = "select usrid from usrclass where classid='$classid'";
my $ref_usrid = $dbh->selectall_arrayref($curSQL);
if (! $ref_usrid){
my $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
writeMsg($message, '36a');
}
my $listusr = '';
foreach my $curusr ( @$ref_usrid ){
$listusr .= ' ' . $curusr->[0];
}
return($listusr);
}
# ============================================================================== getEnableStudentOfClass
sub getEnableStudentOfClass($){
my ($classid) = @_;
my $dbh = $m->comp('dbconnect');
my $sth;
my $ret;
my $curSQL;
my $curfunc = '36b';
$curSQL = "select usrid from usrclass, usr where classid='$classid' and usrclass.profile='[[usr_profile_student]]' and usrclass.permision like '%[[usr_permision_SH]]%' and usrid=usr.id and usr.profile='[[usr_profile_student]]'";
my $ref_usrid = $dbh->selectall_arrayref($curSQL);
if (! $ref_usrid){
my $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
writeMsg($message, $curfunc);
}
my $listusr = '';
foreach my $curusr ( @$ref_usrid ){
$listusr .= ' ' . $curusr->[0];
}
return($listusr);
}
# ============================================================================== getEnableUsrOfClass
sub getEnableUsrOfClass($$){
my ($classid, $condition) = @_;
my $dbh = $m->comp('dbconnect');
my $sth;
my $ret;
my $tablename = 'usrclass';
my $curSQL;
my $curfunc = '36';
$curSQL = "select usrid from $tablename where classid='$classid' and profile='[[usr_profile_student]]' and permision like '$condition' ";
#$m->out( $curSQL);
my $ref_usrid = $dbh->selectall_arrayref($curSQL);
if (! $ref_usrid){
my $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
writeMsg($message, $curfunc);
}
my $listusr = '';
foreach my $curusr ( @$ref_usrid ){
$listusr .= ' ' . $curusr->[0];
}
return($listusr);
}
# ============================================================================== getCurrentUsrid
sub getCurrentUsrid{
# ===================================== This function is as the getprofile component
my $ret = getUsrConnectInfo('usrid');
# my $ret = $m->comp('getprofile', field => 'usrid');
return($ret);
}
# ============================================================================== writeMsgDB
sub writeMsgDB($$){
my($message, $curfunc) = @_;
my $dbh = $m->comp('dbconnect');
my $sth;
my $ret;
my $tablename = 'message';
my $curSQL;
my $setfields;
my $setvalues;
$setfields = "item, message, type, creation";
$setvalues = "nextval('serial_message'),";
my $tilde = "'";
my $space = " ";
$message =~ s/$tilde/$space/g ;
$setvalues .= "'$message', '$curfunc', now()";
$curSQL = "insert into $tablename ($setfields) values ($setvalues) ";
#$m->out( $curSQL);
$sth = $dbh->prepare($curSQL);
$ret = $sth->execute();
if (! $ret){
$curfunc = '37';
my $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;
writeMsg($message, $curfunc);
}
}
# ============================================================================== MAIN
### Process the COMMAND
$retcmd = createCmd($errcmd, $strcmd, $args);
# ============================================================================== END MAIN
</%perl>
%# ============================================================================== CREATE A RESULT PAGE
% if($resultPage){
<BODY>
%# ## Make a Respose Page
<script language="JavaScript">
% if($resultPage eq '2' and $retcmd){
%# when 1, we supposed that after the command been exec, windows must be closed
window.close();
% }elsif($resultPage eq '1' and $retcmd){
%# when 1, we supposed that after the command been exec, fader windows must be closed
window.close();
self.opener.refresh();
self.opener.close();
% }else{
%# we supposed that after the command been exec, the window not must be closed
function myclose()
{
% if($resultPageReturnValue){
self.opener.retFunction('agregar funcionalidad');
% }
self.close();
}
% }
</script>
<table cellspacing="2" cellpadding="2" border="0">
<tr>
<td colspan="4" class="h01"><% ($retcmd) ? 'OK':'Error' %>, realizzando comando</td>
</tr>
%#
<tr>
<td colspan="4" align="center"><input type="button" value="OK" class="boxlook" onClick="javascript:myclose()"></td>
</tr>
% if(! $retcmd){
<tr>
<td colspan="2" width="*">
<textarea rows="3" cols="34" name="error" class="boxlook"><% $errcmd %> <% $retcmd %>
</textarea>
</td>
</tr>
% }
</table>
</BODY>
%#
%################################ Return the result as a background command
% }else{
% return($retcmd);
% }
<%args>
$pg
$ar => 'NULL'
$out => ''
</%args>
<%once>
my $resultPageReturnValue;
</%once>
<%init>
use DBI;
use Data::Dumper;
my $strcmd = $pg;
my $args = $ar;
my $resultPage = $out;
$resultPageReturnValue = ''; ### If is true, whe return a value calling "self.opener.retFunction()"
my $retcmd;
my $errcmd = 'Errore, scrivendo logs';
#$m->out( "$strcmd $args");
# ============================================================================== Validates who calls
my $callFromUnknowUsr = 'TRUE';
my $usrprofile = getUsrConnectInfo('profile');
if($usrprofile eq '[[usr_profile_admin]]' or $usrprofile eq '[[usr_profile_teacher]]' or $usrprofile eq '[[usr_profile_gestion]]'){
$callFromUnknowUsr = '';
}
if($callFromUnknowUsr){
return('???');
}
</%init>