| Current Path : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/Application/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/Application/ServCalendarServer.pm |
package Application::ServCalendarServer;
use strict;
use Application::ServLQServer;
use XML::Parser;
#************************************************************************
sub new {
my $class = shift;
my $self = {};
$self->{'LQH'} = Application::ServLQServer->new();
bless($self,$class);
$self->{'TERMIN_UNIV'} = $main::___PP___->{"termin"};
return($self);
}
#************************************************************************
sub do {
my $self = shift;
my $text = shift;
my $user = shift;
my @pars = @_;
if ($user) {
$self->{'USER'} = $user;
} else {
$self->{'USER'} = "";
}
my @tt = split(/\s+/," ".$text);
shift(@tt);
my $text1; my $o; my $o1; my $o2; my $o3;
my $lqh = $self->{'LQH'};
my $tuniv = $self->{'TERMIN_UNIV'};
#-------------------------------------------------------------------
if (lc($tt[0]) eq "login") {
return($self->login(@tt)); }
if (lc($tt[0]) eq "user" and lc($tt[1]) eq "info") {
return($self->user_info(@tt)); }
if (lc($tt[0]) eq "make" and $tt[1] eq "new" and $tt[2] eq "user") {
return($self->make_new_user(@tt)); }
if (lc($tt[0]) eq "change" and $tt[1] eq "password") {
return($self->change_password(@tt)); }
if (lc($tt[0]) eq "grant" and $tt[1] eq "user") {
return($self->grant_user(@tt)); }
if (lc($tt[0]) eq "new" and lc($tt[1]) eq "calendar") {
return($self->new_calendar(@tt)); }
elsif (lc($tt[0]) eq "show" and lc($tt[1]) eq "calendar") {
return($self->show_calendar(@tt)); }
elsif (lc($tt[0]) eq "show" and lc($tt[1]) eq "termin") {
return($self->show_termin(@tt)); }
elsif (lc($tt[0]) eq "confirm" and lc($tt[1]) eq "termin") {
return($self->confirm_termin(@tt)); }
elsif (lc($tt[0]) eq "delete" and lc($tt[1]) eq "termin") {
return($self->delete_termin(@tt)); }
elsif (lc($tt[0]) eq "change" and lc($tt[1]) eq "termin") {
return($self->change_termin(@tt,@pars)); }
return(0);
}
#************************************************************************
sub xxxmltest {
my $self = shift;
my $text = shift;
$text =~ s/\>[\n\s]*\</\>\</g;
eval("\$text = XML::Parser->new(Style => \'Tree\')->parse(\$text)");
if (ref($text)) { return(1); }
return(0);
}
#************************************************************************
#************************************************************************
sub __user {
my $self = shift;
my $user = shift;
my $passw = shift;
if ($self->{'USER'} and $passw) {
return(@{$self->{'USER'}});
}
my $cursor = $self->{'LQH'}->prepare(
"select x.keyx,x.freetext,x.password from " .
$self->{'TERMIN_UNIV'} . " where " .
"St(x) cur L(x.caluser) and " .
"x.caluser = CONST ?",$user);
$cursor->execute();
my $text = $cursor->fetchrow();
if (!$text) {
if ($user eq "superuser") {
if (!($self->{'___MAKE_NEW_SUPERUSER___'})) {
$self->{'___MAKE_NEW_SUPERUSER___'} = 1;
} else {
return("","");
}
$text = <<'TEXT_ENDE';
::type:: caluser
::caluser:: superuser
::password:: password
::newusers:: Y
::newcals:: Y
::seecals:: ,
::changecals:: ,
::grantcals:: ,
::end::
TEXT_ENDE
$self->{'LQH'}->do("insert into " . $self->{'TERMIN_UNIV'} .
" obj = ?",$text);
return($self->__user("superuser",$passw));
} else {
return("","");
}
}
my $keyx = $text->[0]->[0];
my $password = $text->[2]->[0];
$text = $text->[1]->[0];
if (!$passw or $password eq $passw) {
return($keyx,$text);
}
return("","");
}
#*********************************************************************
sub __caluser {
my $self = shift;
return(<<'TEXT_ENDE');
::type:: caluser
::caluser::
::password:: password
::newusers::
::newcals::
::seecals:: ,
::changecals:: ,
::grantcals:: ,
::end::
TEXT_ENDE
}
#*********************************************************************
sub __calendar_exists {
my $self = shift;
my $cal = shift;
$cal = ",".$cal.",";
my $erg = 0;
my $cursor = $self->{'LQH'}->prepare(
"select x.freetext from " .
$self->{'TERMIN_UNIV'} . " where " .
"St(x) cur L(x.caluser)");
$cursor->execute();
while (0 == 0) {
my $text = $cursor->fetchrow();
last if (!$text);
$text = $text->[0]->[0];
if ($self->freetext($text,"seecals") =~ /$cal/) { $erg = 1; }
if ($self->freetext($text,"changecals") =~ /$cal/) { $erg = 1; }
if ($self->freetext($text,"grantcals") =~ /$cal/) { $erg = 1; }
last if ($erg);
}
$cursor->finish();
return($erg);
}
#**********************************************************************
sub freetext {
my $self = shift;
my $text = shift;
my $par = shift;
my $val = shift;
my $o = "(::".$par."::)( +)(.*?)\n";
if ($val) {
$text =~ s/$o/$1$2$val\n/;
return($text);
} else {
$text =~ /$o/;
return($3);
}
}
#**********************************************************************
#**********************************************************************
# User-Verwaltung
sub login {
my $self = shift;
my $o = shift; return("") if (lc($o) ne "login");
my $user = shift;
my $passw = shift;
my ($keyx,$freetext) = $self->__user($user,$passw);
if ($freetext) {
return([$keyx,$freetext]);
}
return(0);
}
#*******************************************************************
sub user_info {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "user");
my $o1 = shift; return(0) if (lc($o1) ne "info");
my $o3 = shift; return(0) if (lc($o3) ne "account");
my $account = shift;
my ($keyx,$freetext) = $self->__user(split(/,/,$account));
return($freetext);
return(0);
}
#************************************************************************
# Hiermit wird ein neuer User angelegt.
# Die Bedeutung der Rechte-Felder ist:
#
# newusers Y/N Recht zum Anlegen neuer User
# newcals Y/N Recht zum Anlegen neuer Kalender
# seecals kommaseparierte Liste von Kalendern,
# die gesehen werden duerfen
# changecals kommaseparierte Liste von Kalendern,
# die bearbeitet werden duerfen
# grantcals kommaseparierte Liste von Kalendern,
# deren Rechte geaendert werden duerfen
sub make_new_user {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "make");
my $o1 = shift; return(0) if (lc($o1) ne "new");
my $o2 = shift; return(0) if (lc($o2) ne "user");
my $name = shift;
my $o3 = shift; return(0) if (lc($o3) ne "account");
my $account = shift;
my ($keyx,$freetext) = $self->__user(split(/,/,$account));
if ( $self->freetext($freetext,"newusers") ) {
($keyx,$freetext) = $self->__user($name);
return(0) if ($keyx);
my $freetext = $self->__caluser();
$freetext = $self->freetext($freetext,"caluser",$name);
$self->{'LQH'}->do("insert into " . $self->{'TERMIN_UNIV'} .
" obj = ?",$freetext);
return(1);
}
return(0);
}
#************************************************************************
sub change_password {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "change");
my $o1 = shift; return(0) if (lc($o1) ne "password");
my $newp1 = shift;
my $newp2 = shift;
return(0) if ($newp1 ne $newp2);
my $o2 = shift; return(0) if (lc($o2) ne "account");
my $account = shift;
my ($keyx,$freetext) = $self->__user(split(/,/,$account));
$freetext = $self->freetext($freetext,"password",$newp1);
$self->{'LQH'}->do("update in " . $self->{'TERMIN_UNIV'} .
" x.obj = ? where St(x) cur x.keyx = CONST " . $keyx,$freetext);
return([$keyx,$freetext]);
}
#************************************************************************
sub grant_user {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "grant");
my $o1 = shift; return(0) if (lc($o1) ne "user");
my $user = shift;
my $grant = shift;
my $mode = shift;
my $o2 = shift; return(0) if (lc($o2) ne "account");
my $account = shift;
if ($grant !~ /^new/ and $grant !~ /cals$/) { return(0); }
my ($keyx,$freetext) = $self->__user(split(/,/,$account));
my $fr = $freetext;
($user,$freetext) = $self->__user($user);
if ($keyx eq $user) { return(0); }
$keyx = $user;
my $freetext1 = $freetext;
if ($grant !~ /^new/) {
my $grants; my $cal; my $del;
my $g = {};
if ($grant eq "cals") {
$grants = ["seecals","changecals","grantcals"];
$g->{"seecals"} = $self->freetext($freetext,"seecals");
$g->{"changecals"} = $self->freetext($freetext,"changecals");
$g->{"grantcals"} = $self->freetext($freetext,"grantcals");
} else {
$grants = [$grant];
$g->{$grant} = $self->freetext($freetext,$grant);
}
foreach $cal (split(/,/,$mode)) {
next if (!$cal);
$del = 0;
if ($cal =~ s/^-(.*)$/$1/) {
$del = 1;
}
$cal = "," . $cal . ",";
next if ($self->freetext($fr,"grantcals") !~ /$cal/);
foreach $grant (@$grants) {
if ($del) {
$g->{$grant} =~ s/$cal/,/;
}
elsif ($g->{$grant} !~ /$cal/) {
$g->{$grant} = $g->{$grant} . substr($cal,1);
}
}
}
foreach $grant (@$grants) {
$freetext = $self->freetext($freetext,$grant,$g->{$grant});
}
} else {
if ($self->freetext($fr,"newusers") ne "Y") {
return(0);
}
$freetext = $self->freetext($freetext,$grant,$mode);
}
if ($freetext1 ne $freetext) {
$self->{'LQH'}->do("update in " . $self->{'TERMIN_UNIV'} .
" x.obj = ? where St(x) cur x.keyx = CONST " . $keyx,$freetext);
}
return(1);
}
#************************************************************************
sub new_calendar {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "new");
my $o1 = shift; return(0) if (lc($o1) ne "calendar");
my $cal = shift;
my $o2 = shift; return(0) if (lc($o2) ne "account");
my $account = shift;
my ($keyx,$freetext) = $self->__user(split(/,/,$account));
if ($self->freetext($freetext,"newcals") ne "Y") {
return(0);
}
if ($self->__calendar_exists($cal)) {
return(0);
}
$o = $self->freetext($freetext,"seecals");
$freetext = $self->freetext($freetext,"seecals",$o.$cal.",");
$o = $self->freetext($freetext,"grantcals");
$freetext = $self->freetext($freetext,"grantcals",$o.$cal.",");
$o = $self->freetext($freetext,"changecals");
$freetext = $self->freetext($freetext,"changecals",$o.$cal.",");
$self->{'LQH'}->do("update in " . $self->{'TERMIN_UNIV'} .
" x.obj = ? where " .
"St(x) cur x.keyx = CONST " . $keyx,$freetext);
return([$keyx,$freetext]);
}
#************************************************************************
#************************************************************************
# Rueckgabe eines anonymen Termin-Array relativ zum Kalender.
# Jeder Termin besteht aus einem Array, bestehend aus:
# keyx
# Termineintrag
# Terminstatus (siehe unten)
# Datum
# Wenn Terminstatus = 3 (Haupteintrag), dann noch:
# Liste der Anfragen ( jeweils
# Liste der bestaetigten Anfragen ( komma-
# Liste der zurueckgewiesenen Anfragen ( separiert
# sonst noch:
# Name des Hauptkalenders
sub show_calendar {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "show");
my $o1 = shift; return(0) if (lc($o1) ne "calendar");
my $cal = shift;
my $o2 = shift; return(0) if (lc($o2) ne "month");
my $month = shift;
my $o3 = shift; return(0) if ($o3 and lc($o3) ne "account");
my $account = shift;
if ($o3) {
$o1 = "," . $cal . ",";
my ($keyx,$freetext) = $self->__user(split(/,/,$account));
if ($self->freetext($freetext,"seecals") !~ /$o1/) { return(0); }
}
CGP::mm("QQ1");
my $cursor = $self->{'LQH'}->prepare(
"select x.keyx,x.shortcut,x.cals from " .
$self->{'TERMIN_UNIV'} . " where " .
"St(x) " .
# " and L(x.cals) and L(x.shortcut) " .
" cur x.calendar beginswith CONST ?" .
" and x.month beginswith CONST ? " .
" orderby x.startjmd",
$cal." ",$month);
$cursor->execute();
CGP::mm("QQ2");
my $terminliste = [];
my $cal_list; my $stati;
while (0 == 0) {
$o = $cursor->fetchrow();
last if (!$o);
$o->[0] = $o->[0]->[0];
$o->[1] = $o->[1]->[0];
$stati = [0,[],[],[],[],[],[]];
foreach $o1 (split(/,/,$o->[2]->[0])) {
if ($o1 =~ /(\S+)\s+([123456])/) {
push(@{$stati->[$2]},$1);
if (lc($1) eq lc($cal)) {
$o->[2] = $2; # Status des Termins im aktuellen Kalender
}
}
} # Status 4: geloeschte Anfrage
next if ($o->[2] == 5); # Status 5: abgelehnt, Anfrage geloescht
next if ($o->[2] == 6); # Status 6: geloeschter Haupteintrag
if ($o->[2] == 3) { # Status 3: Haupteintrag
push(@$o,join(",",@{$stati->[1]})); # Status 1: Anfrage
push(@$o,join(",",@{$stati->[2]})); # Status 2: Bestaetigte Anfrage
push(@$o,join(",",@{$stati->[5]}));
} else {
$o1 = $stati->[3]->[0];
if (!$o1) {
$o1 = $stati->[6]->[0];
}
push(@$o,$o1);
}
push(@$terminliste,$o);
}
$cursor->finish();
return($terminliste);
}
#***********************************************************************
sub xxshow_termin {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "show");
my $o1 = shift; return(0) if (lc($o1) ne "termin");
my $keyx = shift;
my $o2 = shift; return(0) if (lc($o2) ne "in");
my $o3 = shift; return(0) if (lc($o3) ne "calendar");
my $cal = shift;
my $o4 = shift; return(0) if (lc($o4) ne "account");
my $account = shift;
if ($keyx =~ /(.*),(.*)/) {
$keyx = $2;
}
my $cursor = $self->{'LQH'}->prepare(
"select x.time,x.info,x.cals from " .
$self->{'TERMIN_UNIV'} . " where " .
"St(x) cur x.keyx = CONST " . $keyx);
$cursor->execute();
$keyx = $cursor->fetchrow();
$keyx->[0]->[0] =~ /^(.*),\s*(.*)\s*--\s*(.*)$/;
$o3 = $self->cals_analyse($keyx->[2]->[0]);
$o = [];
$o4 = 1;
foreach $o1 (@$o3) {
if ($o1->[1] == 1 or $o1->[1] == 2 or $o1->[5] == 5) {
push(@$o,$o1->[0]);
}
elsif ($o1->[1] == 3) {
$o4 = 0;
}
}
if ($o4) { $o = []; }
return([$1,$2,$3,$keyx->[1]->[0],join(",",@$o)]);
}
#************************************************************************
# Bestaetigung eines Termins
sub confirm_termin {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "confirm");
my $o1 = shift; return(0) if (lc($o1) ne "termin");
my $keyx = shift;
my $o2 = shift; return(0) if (lc($o2) ne "in");
my $o3 = shift; return(0) if (lc($o3) ne "calendar");
my $cal = shift;
my $o4 = shift; return(0) if (lc($o4) ne "account");
my $account = shift;
my $cursor; my $freetext; my $cals; my $cals_obj;
$o1 = "," . $cal . ",";
my ($keyx1,$freetext1) = $self->__user(split(/,/,$account));
if ($self->freetext($freetext1,"changecals") !~ /$o1/) { return(0); }
foreach $o (split(/,/,$keyx)) {
$cursor = $self->{'LQH'}->prepare(
"select x.freetext from " .
$self->{'TERMIN_UNIV'} . " where " .
"St(x) cur x.keyx = CONST " . $o);
$cursor->execute();
$o1 = $cursor->fetchrow();
next if (!$o1);
$freetext = $o1->[0]->[0];
$freetext1 = $freetext;
$cursor->finish();
$cals = $self->freetext($freetext,"cals");
$cals_obj = $self->cals_analyse($cals);
$self->cals_change($cals_obj,$cal,"1",2);
$cals = $self->cals_print($cals_obj);
$freetext = $self->freetext($freetext,"cals",$cals);
if ($freetext ne $freetext1) {
$self->{'LQH'}->do("update in " . $self->{'TERMIN_UNIV'} .
" x.obj = ? where " .
"St(x) cur x.keyx = CONST " . $o,$freetext);
}
}
}
#*********************************************************************
# Loeschung von Terminen
sub delete_termin {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "delete");
my $o1 = shift; return(0) if (lc($o1) ne "termin");
my $keyx = shift;
my $o2 = shift; return(0) if (lc($o2) ne "from");
my $o3 = shift; return(0) if (lc($o3) ne "calendar");
my $cal = shift;
my $o4 = shift; return(0) if (lc($o4) ne "account");
my $account = shift;
my $cursor; my $freetext; my $cals; my $cals_obj;
$o1 = "," . $cal . ",";
my ($keyx1,$freetext1) = $self->__user(split(/,/,$account));
if ($self->freetext($freetext1,"changecals") !~ /$o1/) { return(0); }
foreach $o (split(/,/,$keyx)) {
$cursor = $self->{'LQH'}->prepare(
"select x.freetext from " .
$self->{'TERMIN_UNIV'} . " where " .
"St(x) cur x.keyx = CONST " . $o);
$cursor->execute();
$o1 = $cursor->fetchrow();
next if (!$o1);
$freetext = $o1->[0]->[0];
$freetext1 = $freetext;
$cals = $self->freetext($freetext,"cals");
$cals_obj = $self->cals_analyse($cals);
$o1 = $self->cals_mode($cals_obj,$cal);
if ($o1 == 3) { # wenn Haupteintrag
$o2 = [];
foreach $o1 (@$cals_obj) {
next if ($self->cals_change($cals_obj,$o1->[0],"12","4"));
next if ($self->cals_change($cals_obj,$o1->[0],"3","6"));
$self->cals_change($cals_obj,$o1->[0],"5",0);
$cals_obj = $self->cals_clear($cals_obj);
}
} else {
if ($self->cals_change($cals_obj,$cal,"4",0)) {
$cals_obj = $self->cals_clear($cals_obj);
}
$self->cals_change($cals_obj,$cal,"1","5");
}
$cals = $self->cals_print($cals_obj);
$freetext = $self->freetext($freetext,"cals",$cals);
if ($freetext ne $freetext1) {
$self->{'LQH'}->do("update in " . $self->{'TERMIN_UNIV'} .
" x.obj = ? where " .
"St(x) cur x.keyx = CONST " . $o,$freetext);
}
}
return(1);
}
#********************************************************************
# Anlegen eines neuen Termins
sub change_termin {
my $self = shift;
my $o = shift; return(0) if (lc($o) ne "change");
my $o1 = shift; return(0) if (lc($o1) ne "termin");
my $keyx = shift;
my $o2 = shift; return(0) if (lc($o2) ne "in");
my $o3 = shift; return(0) if (lc($o3) ne "calendar");
my $cal = shift;
my $o4 = shift; return(0) if (lc($o4) ne "account");
my $account = shift;
my $day = shift;
my $datum = shift;
my $von = shift;
my $bis = shift;
my $text = shift;
my $cals = shift;
print "hier\n";
$o1 = "," . $cal . ",";
my ($keyx1,$freetext1) = $self->__user(split(/,/,$account));
if ($self->freetext($freetext1,"changecals") !~ /$o1/) { return(0); }
$keyx =~ s/\[(.*)\]/$1/;
my $o; my $freetext; my $cursor; my $cals_obj;
if (!$keyx) {
my $cals1 = $cal . " 3";
if ($cals) {
foreach $o (split(/,/,$cals)) {
next if (!$o);
$cals1 = $cals1 . ", " . $o . " 1";
}
}
$freetext = <<'TEXT_ENDE';
::type:: termin
::time:: ---DAY---, ---DATUM---, ---VON--- -- ---BIS---
::info:: ---TEXT---
::cals:: ---CALS---
::end::
TEXT_ENDE
$freetext =~ s/---DAY---/$day/;
$freetext =~ s/---DATUM---/$datum/;
$freetext =~ s/---VON---/$von/;
$freetext =~ s/---BIS---/$bis/;
$freetext =~ s/---TEXT---/$text/;
$freetext =~ s/---CALS---/$cals1/;
print "FF: $freetext\n";
return( $self->{'LQH'}->do("insert into " . $self->{'TERMIN_UNIV'} .
" obj = ?",$freetext) );
}
# Aenderung von Terminen
my $add_cal = [];
my $del_cal = {};
foreach $o (split(/,/,$cals)) {
if (substr($o,0,1) eq "-") {
$del_cal->{substr($o,1)} = 1;
} else {
push(@$add_cal,$o);
}
}
foreach $o (split(/,/,$keyx)) {
$cursor = $self->{'LQH'}->prepare(
"select x.freetext from " .
$self->{'TERMIN_UNIV'} . " where " .
"St(x) cur x.keyx = CONST " . $o);
$cursor->execute();
$o1 = $cursor->fetchrow();
next if (!$o1);
$freetext = $o1->[0]->[0];
$freetext1 = $freetext;
$cals = $self->freetext($freetext,"cals");
$cals_obj = $self->cals_analyse($cals);
$o1 = $self->cals_mode($cals_obj,$cal);
if ($o1 == 3) { # wenn Haupteintrag
my $aendern = 1;
foreach $o1 (@$cals_obj) {
if ($del_cal->{$o1->[0]}) {
$self->cals_change($cals_obj,$o1->[0],"12","4");
} else {
if ($self->cals_mode($cals_obj,$o1->[0]) eq "2") {
$aendern = 0;
}
}
}
foreach $o1 (@$add_cal) {
if (!($self->cals_mode($cals_obj,$o1))) {
push(@$cals_obj,[$o1,1]);
}
}
$cals = $self->cals_print($cals_obj);
$freetext = $self->freetext($freetext,"cals",$cals);
if ($aendern) {
$freetext = $self->freetext($freetext,"info",$text);
$freetext = $self->freetext($freetext,"time",
"$day, $datum, $von -- $bis");
}
} else {
1;
}
if ($freetext ne $freetext1) {
$self->{'LQH'}->do("update in " . $self->{'TERMIN_UNIV'} .
" x.obj = ? where " .
"St(x) cur x.keyx = CONST " . $o,$freetext);
}
}
return(1);
}
#********************************************************************
#********************************************************************
# Hilfsfunktionen
sub cals_analyse {
my $self = shift;
my $cals = shift;
my $o = " ";
$cals =~ s/$o//g;
my $cals_obj = [];
foreach $o (split(/,/,$cals)) {
if ($o =~ /^(\S+)([123456])$/) {
push(@$cals_obj,[$1,$2]);
}
}
return($cals_obj);
}
#********************************************************************
sub cals_print {
my $self = shift;
my $cal_obj = shift;
my $o; my $text = "";
foreach $o (@$cal_obj) {
$text = $text . ", " . $o->[0] . " " . $o->[1];
}
return(substr($text,2));
}
#********************************************************************
sub cals_change {
my $self = shift;
my $cal_obj = shift;
my $cal = shift;
my $xfrom = shift;
my $xto = shift;
my $o; my $o1;
foreach $o (@$cal_obj) {
next if (!$o);
next if ($o->[0] ne $cal);
$o1 = $o->[1];
if ($xfrom =~ /$o1/) {
if (!$xto) {
$o = 0;
} else {
$o->[1] = $xto;
}
return(1);
}
return(0);
}
}
#*********************************************************************
sub cals_mode {
my $self = shift;
my $cals_obj = shift;
my $cal = shift;
my $o; my $new_cals_obj = [];
foreach $o (@$cals_obj) {
next if (!$o);
return($o->[1]) if ($o->[0] eq $cal);
}
return(0);
}
#*********************************************************************
sub cals_clear {
my $self = shift;
my $cals_obj = shift;
my $o; my $new_cals_obj = [];
foreach $o (@$cals_obj) {
next if (!$o);
push(@$new_cals_obj,$o);
}
return($new_cals_obj);
}
1;