Index by: file name |
procedure name |
procedure call |
annotation
admin.tcl
(annotations | original source)
# This source code file is part of the YaaCs package.
#
# Copyright (C) 2002-2006 YaaCers
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (probably in a file named "LICENSE");
# if not, write to:
#
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# $Id: admin.tcl 1464 2008-02-05 08:25:20Z sickpig $
namespace eval ::admin {
# error codes
variable ::admin::ERR
variable ::admin::ERR_UNAME -2
variable ::admin::ERR_IDUR -3
variable ::admin::ERR_WTIME -4
variable ::admin::ERR_SAMPLE -5
variable ::admin::ERR_PAUSE -6
variable ::admin::ERR_FLAG -7
variable ::admin::ERR_IDREQ -8
variable ::admin::ERR_BADT -9
variable ::admin::ERR_STAT -10
variable ::admin::ERR_INSUP -11
variable ::admin::ERR_TPJ -13
variable ::admin::ERR_TSAMP -14
variable ::admin::ERR_TTHEO -15
variable ::admin::ERR_RIDPJ -16
variable ::admin::ERR_MSMS -17
variable ::admin::ERR_ICONT -18
variable ::admin::ERR_SSTR -19
variable ::admin::ERR_SDEF -20
# sql schemas name
variable ::admin::PROJ_SCHEMA "projects"
# cached values
variable ::admin::cachedID 0
array set ::admin::cachedData [list]
variable ::admin::cachedStat ""
# login black list (operators that you don't
# want that interfere with your job such as
# users that you use for test purpose)
variable ::admin::blackList [list '']
}
# clear cached values for project's parameters
#
proc ::admin::clearCache {} {
set $admin::cachedID 0
array set admin::cachedData [list]
set $admin::cachedStat ""
}
# get project statistics table's name
#
# @param db database connection handler
# @param idPj project's id on db
# @return stat table's name or -1 on generic error.
# If data ara available on multiple tables ERR_STAT
# will be returned.
proc ::admin::getStatTable {db idPj} {
# check if cached data can be used
if {$admin::cachedID == $idPj && $admin::cachedStat != ""} {return $admin::cachedStat}
# stats could be on statistiche (for active survey)
# or on storico_statistiche for old unused survey.
set nStat [yadb::getTuple $db "select count(*) from log.activitylog where proj=$idPj" 0]
if {$nStat == -1} {return -1}
set nStor [yadb::getTuple $db "select count(*) from log.activitylog_history where proj=$idPj" 0]
if {$nStor == -1} {return -1}
if {$nStat > 0 && $nStor >0} {
yalog::debug "data ara available both on activitylog and activitylog_history. you should decide what to do!"
set ::admin::ERR $admin::ERR_STAT
return -1
}
set s "log.activitylog"
if {$nStor > 0} {
set s "log.activitylog_history"
}
set admin::cachedStat $s
return $s
}
# do a massive fax send to all contacts of
# a specified project
#
# @param db (sampling) database connection handler
# @param pj project's id on db
# @param faxserver server to be used to send faxes
# @param cover fax template
# @return Return 1 on complete success, 0 if some
# contacts has failed; -1 on error
proc ::admin::massFax {db pj faxserver cover} {
#the update you see all over is a really ugly hack
#to update main window status cause admin::massFax is
#blocking
if {[::sendfax::init $faxserver] == -1} {
::yalog::error "massFax: error in intialization fax process. Please chek your configuration."
return -1
}
set tab [lindex [::yadb::getTuple $db "select pjtable from projects.projects where proj=$pj" 0] 0]
if {$tab == -1} {return -1}
set tab "projects.$tab"
set sqlCountFaxes "select count(*) from $tab where fax is not null and length(btrim(fax)) > 5 and not(fax ilike 'ERR%')"
set countFaxes [lindex [::yadb::getTuple $db $sqlCountFaxes 0] 0]
if {$countFaxes < 0} {
::yalog::error "unable to retrive the number of faxes to be sended"
set ::yadmin::massiveF -1
return -1
}
set ::yadmin::todoFax $countFaxes
update
set ::yadmin::doneFax 0
set sqlMass "select rid, cod_com, fax, reference, phone1, name, employee, field from $tab \
where fax is not null and length(btrim(fax)) > 5 and not(fax ilike 'ERR%')"
set allRight 1
set cmd {
set fax [string trim $rec(fax)]
set ref [string trim $rec(reference)]
set tel [string trim $rec(phone1)]
set name [string trim $rec(name)]
set opt1 $rec(employee)
set opt2 $rec(field)
# create "cover" (this is the fax really ;)
set dataFax [::sendfax::createCover $cover $fax $ref $tel $name $opt1 $opt2]
# send the fax (make sure hylafax user admin should send fax
# from the box you run yadmin)
set sentRes [::sendfax::send $dataFax $fax admin]
if { $sentRes < 0} {
::yalog::error "massFax: error while sending fax for contact (id=$rec(rid);cod_com=$rec(cod_com)) \
for project $pj"
#this is a critical error while sending fax, sendfax::send return -1 only if it isnt
# able to open a connection to the fax server
set ::yadmin::massiveF -1
return -1
}
# log the event on db
if {[::yadb::execl $db "insert into log.fax (fax,proj,status,rid,touch) \
values ('$fax',$pj,'t',$rec(rid),now())"] == -1} {
::yalog::error "massFax: unable to log fax sent for contact (id=$rec(rid);cod_com=$rec(cod_com)) project $pj"
# I think we could "ignore" this error and go on with other contacts
# if you don't agree with me you can mail me (bugant@opinioni.net) or
# add a return statement here.
}
incr ::yadmin::doneFax
update
}
if {[::yadb::pgSelect $db $sqlMass rec $cmd] < 0} {return -1}
return $allRight
}
# do a massive mail send to all contacts of
# a specified project
#
# @param db (sampling) database connection handler
# @param pj project's id on db
# @param mailserver server to be used to send emails
# @param fromadd from email address
# @param path mail's body file path
# @return Return 1 on complete success, 0 if some
# contacts has failed; -1 on error
proc ::admin::massMail {db pj mailserver fromadd path} {
set home [yaconf::checkLocalConf]
if {$mailserver == "" || $fromadd == ""} {
yalog::error "massMail: invalid settings for mail server and from address."
return -1
}
if {$path == ""} {
yalog::error "massMail: a path for mail's body hasn't been supplied."
return -1
}
set pjData [yadb::getTuple $db "select pjtable, description, listed from projects.projects where proj=$pj" 0]
if {$pjData == -1} {return -1}
set tab [lindex $pjData 0]
set desc [string trim [lindex $pjData 1]]
set listed [lindex $pjData 2]
if {$listed == "t"} {
set sqlMass "select rid, cod_com, email_addr, reference, name, employee, field from projetcs.$tab \
where email_addr is not null"
} else {
set sqlMass "select rid, cod_com, email_addr, name as reference, name, employee, field from projects.$tab \
where email_addr is not null"
}
# be positive
set allRight 1
set cmd {
set email [string trim $rec(email_addr)]
set ref [string trim $rec(reference)]
set name [string trim $rec(name)]
set opt1 $rec(employee)
set opt2 $rec(field)
# check email address
if {[sendmail::validateMail $email]==0} {
yalog::error "massMail: invalid email address $email"
set allRight 0
} else {
set fd_m [open $path]
set body_a [read $fd_m]
close $fd_m
set body_a [string map [list "\\\n" " "] $body_a]
set body ""
foreach line [split $body_a \n] {
set line [string map [list REFERENTE $ref] $line]
set line [string map [list RAGIONE_SOCIALE $name] $line]
set line [string map [list US $opt1] $line]
set line [string map [list PASS $opt2] $line]
set body "$body$line\n"
}
set resmail [::sendmail::send $fromadd $email $desc $body $mailserver]
if { [string length $resmail] > 0 } {
::yalog::error "massMail: problem while sending email, err msg:\n\t $resmail"
set allRight 0
}
# log the event on db
if {[yadb::execl $db "Insert into log.email (addr,proj,status,rid,touch,cod_com) \
values ('$email', $pj, 't', $rec(rid), now(), $rec(cod_com))"] == -1} {
yalog::error "massMail: unable to log mail sent for contact (rid=$rec(rid);cod_com=$rec(cod_com) \
project $pj"
}
}
}
if {[yadb::pgSelect $db $sqlMass rec $cmd] < 0} {return -1}
return $allRight
}
# get all sampling algorithm implemented
#
# @param db database connection handler
# @return array containing all sampling
# algorithm implemented. Each array
# element contains a list with the
# corresponding id, a description and
# the two aux tables' name. Return -1
# on error.
proc ::admin::getSamples {db} {
set sqlSamples "select id, typeof, theo_tab_name, sample_tab_name, description \
from sampling.sampling_types where choosable"
set cmd {
set ret($rec(typeof)) [list $rec(id) $rec(description) $rec(theo_tab_name) $rec(sample_tab_name)]
}
set pg [::yadb::pgSelect $db $sqlSamples rec $cmd]
if {$pg < 0} {return -1}
return [array get ret]
}
# get all project's attribute. try to use
# cached value if possible.
#
# @param db database connection handler
# @param idPj project's id on db
# @return attributes' list as specified
# by namespace vars; -1 on error.
proc ::admin::getDataPj {db idPj} {
# check if cached data can be used
if {$admin::cachedID == $idPj && [array size admin::cachedData] != 0} {return [array get ::admin::cachedData]}
array set ret [::yadb::getTupleArray $db "select * from projects.projects where proj=$idPj"];
if { [array size ret] == 0 } {
::yalog::error "no project found with the specified id: $idPj"
return [list]
}
set suffix "_theo"
set tab [join [list $::admin::PROJ_SCHEMA $ret(pjtable)] "."]
set tab [string trim $tab]
set tabT $tab$suffix
set tabS [lindex [::yadb::getTuple $db "select sample_tab_name from sampling.sampling_types \
where id=$ret(sampling_type)" 0] 0]
set ret(pjtable_theo) $tabT
set ret(sample_table) $tabS
set ret(pjtable) $tab
set admin::cachedID $idPj
array set ::admin::cachedData [array get ret]
# invalidate cached value for stat table
# otherwise I must 'recalculate' it.
set ::admin::cachedStat ""
return [array get ret]
}
# getOperators - get a list of all operators
# which have been involved into a project.
#
# @param db (operators) database connection handler
# @param idPj project's id on db
# @return ops list; -1 on error.
proc ::admin::getOperators {db idPj} {
set res [list]
if {$idPj == ""} {
::yalog::error "a valid project's has to be supplied."
return -1
}
set touch [lindex [::yadb::getTuple $db "select pjstart from projects.projects where proj=$idPj" 0] 0]
if {$touch == -1} {
::yalog::error "cannot retrive project's creation timestamp."
return -1
}
set cmd {
lappend res $rec(rid)
}
set strBlack ""
foreach b $::admin::blackList {
if {$strBlack == ""} {
set strBlack $b
} else {
set strBlack "$strBlack, $b"
}
}
set doIt [::yadb::pgSelect $db "select distinct i.uid as rid, i.name, i.surname, i.login \
from log.activitylog as s, interviewers.interviewers as i where \
s.proj=$idPj and date(start_work) >= $touch and end_work is null and s.uid=i.uid \
and login not in ($strBlack) \
order by i.surname, i.name" \
rec $cmd]
if {$doIt < 0} {
::yalog::error "cannot retrive all operators involved in project $idPj; it's due to a db error."
return -1
}
return $res
}
# create/edit a new cati project
#
# @param ce choose if you want to create (0) or edit (1) a project
# @param db database connection handler
# @param dbInt operators' database connection handler
# @param name survey project's name
# @param desc survey project's description
# @param duration when does this project start/end? (two dates list)
# @param wtime list which specifies how long do you have to wait for
# a call back for no answer, busy, fax machine and answering
# machine respectively. (times are expressed in minutes)
# @param active flag which says if the project is running (!0) or not (0)
# @param is4company flag which says if the project's refered to company (!0) or not (0)
# @param maxt max numeber re-calling times
# @param samplet sample type expressed by an integer which unique identify the
# algorithm you want to apply
# @param soglia used for a specific type of sample
# @param pausep pause's params; a two elements list reporting max minutes for
# a pause duration and for their sum
# @param freqmon monitoring update frequence
# @param table default setted to name; db's table name to store project's data
# @param url default setted to ""; url to point a browser to do the survey
# @param shiftDef a messed list of list, each sublist contains turns id, day, seats
# smstxt, updatelist and massSms, action
# @param impS file and file's structured where contacts are stored
# @param g_stuff a list of 4 params that affect operator's GUI (1st show contact name,
# 2nd mandatory callback anagraphic data, 3rd mandatory anagraphic data on completed
# and 4th auto call definition: 0 no auto call, 1 auto call always on, 2 user selectable
# @param idPj [optional] project's id on db; use it if you're editing a project.
# @return return 0 on success, -1 on generic error, ERR_UNAME for not unique (or null) name,
# ERR_IDUR for an invalid duration, ERR_WTIME for error caused by wtime's value,
# ERR_SAMPLE for error caused by a bad samplet, ERR_PAUSE for bad pausep.
# ERR_FLAG is returned if you try to call newUpPj with a wrong ce flag; remember
# that if you're editing a project you've to supply a project's id or you'll
# get an ERR_IDREQ.
proc ::admin::newUpPj {ce db name desc duration wtime active is4company maxt\
samplet soglia pausep freqmon table url shiftDef impS g_stuff {idPj ""}} {
# ce should be 0 (zero) for create a project
# and 1 (one) to edit it. If you're editing
# it, I need the project's id.
if {!($ce == 0 || $ce == 1)} {
::yalog::error "wrong create/edit flag. It should be 0 (zero) or 1 (one)."
return $admin::ERR_FLAG
}
if {$ce == 1 && $idPj == ""} {
::yalog::debug "project's id is required for editing a project."
return $admin::ERR_IDREQ
}
# check for not null name
if {$name == ""} {
::yalog::debug "a project name is required."
return $admin::ERR_UNAME
}
# check for name uniqueness, if not report this as a debug in logs
# and return.
set uniquen [yadb::getTuple $db "select count(*) from projects.projects where lower(name)::bpchar='$name'" 0]
if {$uniquen == -1} {
return -1
}
if {$ce == 0 && $uniquen > 0} {
::yalog::debug "the name choosen for the new project already exist."
return $admin::ERR_UNAME
}
#check for duration consistency start < end,if not report to logs and return
set start [lindex $duration 0]
set end [lindex $duration 1]
set durcheck [yadb::getTuple $db "select date '$end' - date '$start'" 0]
if {$durcheck == -1} {
::yalog::error "pj start is bigger than pj end"
return -1
}
if {$durcheck < 0} {
::yalog::debug "invalid duration setted"
return $admin::ERR_IDUR
}
#check wtime
if {[llength $wtime] != 5} {
::yalog::debug "invalid waiting times: the list must contain 4 elements"
return $admin::ERR_WTIME
}
foreach w $wtime {
if {[string length $w] == 0} {
::yalog::debug "invalid waiting time: you must supply a value for each parameters"
return $admin::ERR_WTIME
}
}
set noanswer [lindex $wtime 0]
set busy [lindex $wtime 1]
set fax [lindex $wtime 2]
set answermachine [lindex $wtime 3]
set sms [lindex $wtime 4]
#check pausep
if {[llength $pausep] != 2} {
::yalog::debug "invalid pause setting values: the list must contain 2 elements"
return $admin::ERR_PAUSE
}
set maxp [lindex $pausep 0]
set sump [lindex $pausep 1]
#check for sample method type
if {[string length $samplet] == 0} {
::yalog::debug "you must supply a sample method for the project"
return $admin::ERR_SAMPLE
}
#if no table name has been supplied, set it to project's name (lower case)
if {[string length $table] == 0} {
set table [string tolower $name]
regsub -all " " $table "" table
}
#converts flag to boolean
if {$active == 0} {
set active "f"
} else {
set active "t"
}
if {$is4company == 0} {
set is4company "f"
} else {
set is4company "t"
}
if {$soglia == ""} {
set soglia "null"
}
if {$shiftDef eq ""} {
::yalog::debug "no shift definition"
set doShiftDef 0
} else { set doShiftDef 1 }
if {$impS eq ""} {
::yalog::debug "no importation"
set doImpS 0
} else { set doImpS 1 }
#gui stuff handling
set show_name [lindex $g_stuff 0]
set mandatory_cb [lindex $g_stuff 1]
set mandatory_r [lindex $g_stuff 2]
set auto_call [lindex $g_stuff 3]
#ok try do things in a acid way ;)
::yadb::execl $db "begin"
if {$ce == 0} {
set sqlNewUp "insert into projects.projects (name,description,noresp_wait,busy_wait,fax_wait,\
machine_wait,sms_wait,active,pjtable,listed,max_retry,sampling_type,\
threshold,max_pause,sum_pause,freq_mon,pjstart,pjend,url,show_name,\
anagraphic_callback,anagraphic_completed,auto_call) values (\
'$name','$desc','$noanswer','$busy','$fax','$answermachine','$sms','$active','$table','$is4company',\
$maxt, $samplet, $soglia, $maxp, $sump, $freqmon, '$start', '$end', '$url',\
'$show_name', '$mandatory_cb', '$mandatory_r', $auto_call)"
} else {
#here $ce == 1 for sure.
set sqlNewUp "update projects.projects set description='$desc', noresp_wait='$noanswer', busy_wait='$busy',\
fax_wait='$fax', machine_wait='$answermachine', sms_wait='$sms',active='$active', pjtable='$table',\
listed='$is4company', max_retry=$maxt, sampling_type=$samplet,\
threshold=$soglia, max_pause=$maxp, sum_pause=$sump, freq_mon=$freqmon,\
pjstart='$start', pjend='$end', url='$url', \
show_name='$show_name', anagraphic_callback='$mandatory_cb', \
anagraphic_completed='$mandatory_r', auto_call=$auto_call
where proj=$idPj"
set sqlRecr "update recruitments.recruitments set open='$active' where proj=$idPj"
}
if {[::yadb::execl $db $sqlNewUp] == -1} {
::yalog::error "insert/update projects.projects failed"
::yadb::execl $db "rollback"
return $::admin::ERR_INSUP
}
if {[::info exists sqlRecr]} {
if {[yadb::execl $db $sqlRecr] == -1} {
::yalog::error "update recruitments flag failed"
::yadb::execl $db "rollback"
return $::admin::ERR_RECR
}
}
if {$ce == 0} {
set sqlCreate "create table projects.$table (like projects.template including defaults)"
if {[yadb::execl $db $sqlCreate] == -1} {
::yalog::error "pj table creation failed"
::yadb::execl $db "rollback"
return $::admin::ERR_TPJ
}
# create sampling aux table
set auxTabs [yadb::getTuple $db "select theo_tab_name, sample_tab_name from sampling.sampling_types where id=$samplet" 0]
if {$auxTabs == -1} {
::yalog::error "retriving sampling template aux table failed"
::yadb::execl $db "rollback"
return $::admin::ERR_TSAMP
}
set theo [lindex $auxTabs 0]
set camp [lindex $auxTabs 1]
if {$is4company == "f" && $theo != "" && $camp != ""} {
set theoName "_theo"
set theoName $table$theoName
set theoTab [yadb::execl $db "Create table projects.$theoName as select * from $theo limit 0"]
if {$theoTab == -1} {
::yalog::error "creation of theo project table failed"
::yadb::execl $db "rollback"
return $::admin::ERR_TTHEO
}
}
}
if {$ce == 0} {
#we've to retrive id for this new pj
set idPj [lindex [::yadb::getTuple $db "select currval('projects.projects_proj_seq'::text)" 0] 0]
if {$idPj == -1} {
::yalog::error "unable to get proj id for the just created project"
::yadb::execl $db "rollback"
return $::admin::ERR_RIDPJ
}
}
if {$doShiftDef} {
if {[::admin::setTurns $db $idPj $shiftDef] == -1} {
::yalog::error "Cannot save shift setted for the new project"
::yadb::execl $db "rollback"
return $::admin::ERR_SDEF
}
}
if {$doImpS && $is4company} {
if {[::admin::importFile $db $idPj [lindex $impS 1] [lindex $impS 0]] < 0} {
::yalog::error "Cannot import contacts"
::yadb::execl $db "rollback"
return $::admin::ERR_ICONT
}
}
if {$doImpS && !$is4company} {
if {[::admin::importSampleStructure $db $idPj $impS] == -1} {
::yalog::error "Cannot import sample structure"
::yadb::execl $db "rollback"
return $::admin::ERR_SSTR
}
}
::yalog::debug "project creation/update succesfully completed"
::yadb::execl $db "commit"
return 0
}
# when max_retry is raised we have to put in place again
# contacts marked as dead (ouid = -4) when max_retry was lower
proc ::admin::refreshOldContact {db idPj pjname oldM newM} {
return [::yadb::execl $db "update projects.$pjname set ouid = null, touch = null \
where retry < $newM and ouid=$::cati::lastTryOuid"]
}
# a wrap around delPjReal
proc ::admin::delPj {db idPj} {
# make things transaction safe
if {[::yadb::execl $db "begin"] == -1} {
::yalog::error "\[admin::delPj\] Unable to open a transaction"
return -1
}
if {[::admin::delPjReal $db $idPj] == -1} {
::yalog::error "\[admin::delPj\] Unable to delete projects \[$idPj\]"
::yadb::execl $db "rollback"
return -1
}
::yadb::execl $db "commit"
return
}
# delete a project
#
# @param db database connection handler
# @param idPj project's id on db.
# @return return 0 on success, -1 on generic error,
# ERR_IDREQ for null project's id.
proc ::admin::delPjReal {db idPj} {
# check for null project's id
if {$idPj == ""} {
::yalog::error "project id required."
set ::admin::ERR $admin::ERR_IDREQ
return -1
}
#delete scheduled callbacks
set backSchedule [::yadb::execl $db "insert into history.schedule select * from projects.schedule where proj=$idPj"]
set delSchedule [::yadb::execl $db "delete from projects.schedule where proj=$idPj"]
if {$backSchedule==-1 || $delSchedule==-1} {
::yalog::error "unable to delete callbacks for project $idPj"
return -1
}
#FIXME: maybe we to move also respondents anagraphic data
#log_fax andlog_emai entries (think about it)
set tableName [lindex [::yadb::getTuple $db "select pjtable from projects.projects where proj=$idPj" 0] 0]
if {$tableName == -1} {
return -1
}
set tableName [string trim $tableName]
set tableNameTheo [join [list $tableName _theo] ""]
set stoTableName [join [list $tableName _ $idPj] ""]
set stoTableNameTheo [join [list $tableNameTheo _ $idPj] ""]
if {[::yadb::execl $db "create table history.$stoTableName as select * from projects.$tableName"] == -1} {
return -1
}
if {[::yadb::getNumTuples $db \
"select table_name from information_schema.tables \
where table_schema='projects' and table_name='$tableNameTheo'"\
] > 0} {
#we've found a theo table ;)
if {[::yadb::execl $db "create table history.$stoTableNameTheo as select * from projects.$tableNameTheo"] == -1} {
return -1
}
if {[::yadb::execl $db "drop table projects.$tableNameTheo"] == -1} {
return -1
}
}
if {[::yadb::execl $db "drop table projects.$tableName"]} {
return -1
}
if {[::yadb::execl $db "insert into history.projects select * from projects.projects where proj=$idPj"] == -1} {
return -1
}
return [::yadb::execl $db "delete from projects.projects where proj=$idPj"]
}
# get turn/shift name bi turn id
proc ::admin::getIdtByTName {db idt} {
return [lindex [::yadb::getTuple $db "select btrim(turn) from projects.turns where idt=$idt" 0] 0]
}
# set a project duration
#
# @param db database connection handler
# @param pj project's id on db
# @param start start date
# @param end end date
# @return returns 0 on success, -1 on error
proc ::admin::setPjDuration {db pj start end} {
if {$pj eq "" || $start eq "" || $end eq ""} {
return -1
}
set sql "update projects.projects set pjstart='$start', pjend='$end' \
where proj=$pj"
if {[::yadb::execl $db $sql] == -1} {
::yalog::errror "cannot update project duration"
return -1
}
return 0
}
# get all turns defined on db
#
# @param db database connection handler
# @return list of all turns; each elements is
# a list itself containing all turn's property.
# Return -1 on error.
proc ::admin::getTurns {db} {
set ret [list]
set sql "select * from projects.turns order by idt"
set cmd {
set ret [lappend ret [list $rec(idt) $rec(turn) $rec(tstart) $rec(tend)]]
}
set turns [yadb::pgSelect $db $sql rec $cmd]
if {$turns < 0} {
if {$turns == -1} {
yalog::error "error in the block command executed by pgSelect"
} else {
yalog::error "error in the SQL statement executed by pgSelect"
}
return -1
}
return $ret
}
# get project's turns for a specified date
#
# @param db (sampling) database connection handler
# @param pj project's id on db
# @param date the date for which you want to retrive informations
# @return return a list composed by a string with
# all turns' name setted for the specific
# date and the pos available;
# return -1 on error.
proc ::admin::getPjTurns {db pj date} {
set ret [list]
set str ""
set pos 0
set sql "select turn,seats \
from projects.tupjs i, projects.turns t \
where i.idt=t.idt and i.proj=$pj \
and i.day='$date'::date"
set cmd {
set str "$str $rec(turn)"
set pos $rec(seats)
}
set turns [yadb::pgSelect $db $sql rec $cmd]
if {$turns < 0} {
if {$turns == -1} {
yalog::error "error in the block command executed by pgSelect"
} else {
yalog::error "error in the SQL statement executed by pgSelect"
}
return -1
}
set str [string trim $str]
set ret [list $str $pos]
return $ret
}
#
# set turns for a project
#
# @param db (sampling) database connection handler
# @param pj project's id on db
# @param turns list of all turns to be saved. Each
# element of the list is it self a three
# elements list composed by {date,turns' id, pos}
# @return Return 0 on success; -1 on error
proc ::admin::setTurns {db pj turns} {
# SQL stuff to be done:
# > delete all previous turns; (3)
# > inserting new turns; (4)
# > commit; (5)
# (3)
if {[yadb::execl $db "delete from projects.tupjs where proj=$pj"] == -1} {
return -1
}
# (4)
foreach t $turns {
set date [lindex $t 0]
set ts [lindex $t 1]
set pos [lindex $t 2]
if {$pos eq ""} {set pos null}
if {$ts == ""} {
set sql "insert into projects.tupjs (proj, idt, day, seats, booked) \
values ($pj, null, '$date'::date, $pos, 0)"
if {[yadb::execl $db $sql] == -1} {
return -1
}
} else {
foreach idt [split $ts] {
set sql "insert into projects.tupjs (proj, idt, day, seats, booked) \
values ($pj, $idt, '$date'::date, $pos, 0)"
if {[yadb:::execl $db $sql] == -1} {
return -1
}
}
}
}
return 0
}
# create/edit a turn
#
# @param ce choose if you want to create (0) or edit (1) a turn
# @param db database connection handler
# @param name turn's name
# @param start turn's start (time without time zone)
# @param end turn's end (time without time zone)
# @param idT [optional] turn's id on db. Use it to edit a turn.
# @return return 0 on success, -1 on generic error, ERR_UNAME for not unique
# or null name, ERR_IDUR for invalid turn duration. If you set ce to
# somewhat other than its legal values you'll get an ERR_FLAG. Remember
# that if you're editing a turn you must supply its id otherwise an
# ERR_IDREQ will be raised.
proc ::admin::newUpTurn {ce db name start end {idT ""}} {
# check for ce. it should be 0 or 1.
if {!($ce == 0 || $ce == 1)} {
yalog::debug "wrong create/edit flag $ce."
return $admin::ERR_FLAG
}
# check for idT if you're editing
if {$ce == 1 && $idT == ""} {
yalog::debug "turn id is required on editing."
return $admin::ERR_IDREQ
}
# check for not null name
if {$name == ""} {
yalog::debug "a turn's name is required"
return $admin::ERR_UNAME
}
# check for name uniqueness
set uniquen [yadb::getTuple $db "select count(*) from projects.turns where lower(turn)::bpchar=lower('$name')" 0]
if {$uniquen == -1} {
return -1
}
if {($uniquen > 0 && $ce == 0) || $uniquen > 1} {
yalog::debug "the name choosen for the turn already exsist."
return $admin::ERR_UNAME
}
# check for start-end consistency
set dur [yadb::getTuple $db "select (time '$end' - '$start') > '00:00:00'::interval" 0]
if {$dur == -1} {
return -1
}
if {$dur == "f"} {
yalog::debug "invalid turn duration $start - $end."
return $admin::ERR_IDUR
}
if {$ce == 0} {
set sqlNewUpT "insert into projects.turns (turn, tstart,tend ) values ('$name', '$start', '$end')"
} else {
# I'm sure that ce == 1
set sqlNewUpT "update projects.turns set turn='$name', tstart='$start', tend='$end' where idt=$idT"
}
if {[yadb::execl $db $sqlNewUpT] == -1} {
return -1
}
return 0
}
# delete a turn
#
# @param db database connection handler
# @param idT turn's id on db.
# @return return 0 on success, -1 on generic error,
# ERR_IDREQ for null turn's id.
proc ::admin::delTurn {db idT} {
# check for null turn's id
if {$idT == ""} {
yalog::debug "turn id required."
return $admin::ERR_IDREQ
}
return [yadb::execl $db "delete from projects.turns where idt=$idT"]
}
# flush stat for a project: move data from statistiche
# to storico_statistiche.
#
# @param db (operators) database connection handler
# @param idPj project's id on db
# @return Return 0 on success, -1 on generic error.
# Return ERR_IDREQ for invalid project's id.
proc ::admin::flushStat {db idPj} {
if {$idPj < 0 || $idPj == ""} {
return $admin::ERR_IDREQ
}
# we want to move all data so I'm going
# to avoid any activity on statistiche
if {[::yadb::execl $db "begin"] == -1} {return -1}
# let's move the data (1) copying them to storico_statisitche
# and (2) deleting them.
if {[::yadb::execl $db "insert into log.activitylog_history select * from log.activitylog where proj=$idPj"] == -1} {
::yadb::execl "rollback"
return -1
}
if {[::yadb::execl $db "delete from log.activitylog where proj=$idPj"] == -1} {
::yadb::execl "rollback"
return -1
}
if {[::yadb::execl $db "commit"] == -1} {
::yadb::execl "rollback"
return -1
}
return 0
}
# perform quota checking; you can choose between 2
# types of them setting the type parameter.
#
# @param db database connection handler
# @param idPj project's id on db.
# @param type integer that specify the type of quota checking to
# perform;you can choose from:
# 0: stands x geographical quota (completed interviews)
# 1: stands x geographical quota (distance from goal)
# 2: stands x gender-age quota
# @param quota output parameter. it's a list which contains
# results.
# @return return a list which contains results otherwise:
# -1 for a generic error
# ERR_BADT on wrong quota type.
proc ::admin::quotaCheck {db idPj type qPerc {deflist ""}} {
array set ares [array get dummy]
set quota [list]
# which sampling algorithm are you using?
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return [list error -1]}
if {[array names dataPj -exact sampling_type] == ""} {
return [list error -1]
}
set samplet $dataPj(sampling_type)
# perform the quota checking you've specified
switch -- $type {
0 -
1 { # quote territoriali
switch -- $samplet {
0 { # cod prov-capoluo
set ares(title) [mc "Geographical Quota Cod_prov - capoluo"]
set ares(header) "{[mc "Cod Prov"]} {[mc "Capoluogo"]} {[mc "Non Capoluogo"]}"
set ares(quota) [::admin::quotaCodProv $db $idPj $type $qPerc]
}
1 { # ruotato
set ares(title) [mc "Geographical Quota Rotated"]
set ares(header) "{[mc "Sub Strata"]} {[mc "Completed"]}"
set ares(quota) [::admin::quotaRuotato $db $idPj $type]
}
2 { # cod col
set ares(title) [mc "Geographical Quota Stratified"]
set ares(header) "{[mc "Cod Col"]} {[mc "Completed"]} {[mc "Coverage"]}"
set ares(quota) [::admin::quotaCodCol $db $idPj $type]
}
4 { # sostituzione
set ares(title) [mc "Geographical Quota Probabilistic"]
set ares(header) "{[mc "Cod Col"]} {[mc "Completed"]}"
set ares(quota) [::admin::quotaSost $db $idPj $type]
}
5 { # cod col-pop res
set ares(title) [mc "Geographical Quota Stratified - Threshold"]
set ares(header) "{[mc "Cod Col"]} {[mc "<= Threshold"]} {[mc "> Threshold"]}"
set ares(quota) [::admin::quotaCodColS $db $idPj $type]
}
3 { #su lista (ex-azienda)
set ares(header) "{ } { } { }"
set ares(title) [mc "List Project"]
set ares(quota) 1
}
default {
return [list error $admin::ERR_BADT]
}
}
}
2 { # quote genere-eta'
set ares(title) [mc "Gender Age Quota"]
set ares(header) "{[mc "Age"]} {[mc "Male"]} {[mc "Female"]}"
set ares(quota) [::admin::quotaGenAge $db $idPj $deflist]
}
default {
return [list error $admin::ERR_BADT]
}
}
if {$ares(quota)!= -1} {
return [array get ares]
} else {
return [list error -2]
}
}
# quotaGendAge checking for gender and age
#
# @param db database connection handler
# @param idPj project's id on db.
# @return quota list, -1 on generic error.
proc ::admin::quotaGenAge {db idPj deflist} {
set sqlM "select count(*) from projects.respondents where proj = $idPj and sex = 'M' and byear between"
set sqlF "select count(*) from projects.respondents where proj = $idPj and sex = 'F' and byear between"
set year [::yadb::getTuple $db "select extract(year from now())" 0]
set retlist [list]
for {set i 0} {$i < [llength $deflist]} {incr i 2} {
if {[lindex $deflist [expr ($i + 1)]]=="+"} {
set inf [expr $year - 200]
set llabel " >= [lindex $deflist $i] "
} else {
set inf [expr $year - [lindex $deflist [expr ($i + 1)]]]
set llabel "[lindex $deflist $i] - [lindex $deflist [expr ($i + 1)]]"
}
set sup [expr $year - [lindex $deflist $i]]
set numM [::yadb::getTuple $db "$sqlM $inf and $sup" 0]
set numF [::yadb::getTuple $db "$sqlF $inf and $sup" 0]
lappend retlist $llabel $numM $numF
}
return $retlist
}
# quota checking for cod_prov-capoluo
#
# @param db database connection handler
# @param idPj project's id on db.
# @param type integer that specify if yuo want
# numerosita' or distanza dall'obiettivo.
# @return quota list, -1 on generic error.
proc ::admin::quotaCodProv {db idPj type qPerc} {
::yalog::debug "qPerc $qPerc"
set res [list]
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return -1}
set tabPj $dataPj(pjtable)
set tabT $dataPj(pjtable_theo)
set sqlTot "Select cod_prov,qty_capo,qty_not_capo from $tabT order by cod_prov"
set code {
set sqlC "select count(*) from $tabPj where ouid = 8 and capoluo = 1 and cod_prov = $rec(cod_prov)"
set sqlN "select count(*) from $tabPj where ouid = 8 and capoluo = 0 and cod_prov = $rec(cod_prov)"
set numC [::yadb::getTuple $db $sqlC 0]
if {$numC == -1} {return -1}
if {$type == 1} {set numC [expr $rec(qty_capo) - $numC]}
set percC 0
if {$rec(qty_capo) != 0} {set percC [expr [expr $numC/$rec(qty_capo).0] * 100]}
set numN [yadb::getTuple $db $sqlN 0]
if {$numN == -1} {return -1}
if {$type == 1} {set numN [expr $rec(qty_not_capo) - $numN]}
set percN 0
if {$rec(qty_not_capo)!= 0} {set percN [expr [expr $numN/$rec(qty_not_capo).0] * 100]}
if { $qPerc == 0} {
lappend res $rec(cod_prov) $numC $numN
} else {
lappend res $rec(cod_prov) [format "%3.2f" $percC] [format "%3.2f" $percN]
}
}
if {[::yadb::pgSelect $db $sqlTot rec $code] < 0} {
return -1
}
return $res
}
# quota checking for ruotato
#
# @param db database connection handler
# @param idPj project's id on db.
# @param type integer that specify if yuo want
# numerosita' or distanza dall'obiettivo.
# @return quota list, -1 on generic error.
proc ::admin::quotaRuotato {db idPj type} {
set res [list]
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return -1}
set tabPj $dataPj(pjtable)
set tabT $dataPj(pjtable_theo)
set sqlTot "select strata,sum(qty) as tobedone from $tabT group by strata order by strata"
set code {
set sql "select count(*) from $tabPj where ouid = 8 and strata = $rec(strata) "
set num [yadb::getTuple $db $sql 0]
if {$num == -1} {return -1}
if {$type == 1} {set num [expr $rec(tobedone) - $num]}
lappend res $rec(strata) $num
}
if {[::yadb::pgSelect $db $sqlTot rec $code] < 0} {
return -1
}
return $res
}
# quota checking for Stratified sample
#
# @param db database connection handler
# @param idPj project's id on db.
# @param type integer that specify if yuo want
# numerosita' or distanza dall'obiettivo.
# @return quota list, -1 on generic error.
proc ::admin::quotaCodCol {db idPj type} {
set res [list]
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return -1}
set tabPj $dataPj(pjtable)
set tabT $dataPj(pjtable_theo)
set sqlTot "select strata,qty as tobedone from $tabT order by strata"
set code {
set sql "select count(*) from $tabPj where ouid = 8 and strata = $rec(strata)"
set num [::yadb::getTuple $db $sql 0]
if {$num == -1} {return -1}
if {$type == 1} {set num [expr $rec(tobedone) - $num]}
set perc 0
if {$rec(tobedone) != 0} {set perc [expr [expr $num/$rec(tobedone).0] * 100]}
::yalog::debug "quota: $rec(strata) $num $perc"
lappend res $rec(strata) $num [format "%3.2f" $perc]
}
if {[::yadb::pgSelect $db $sqlTot rec $code] < 0} {
return -1
}
return $res
}
# quota checking for sostituzione
#
# @param db database connection handler
# @param idPj project's id on db.
# @param type integer that specify if yuo want
# numerosita' or distanza dall'obiettivo.
# @return quota list, -1 on generic error.
proc ::admin::quotaSost {db idPj type} {
set res [list]
set perc 100
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return -1}
set tabPj $dataPj(pjtable)
set tabT $dataPj(pjtable_theo)
set sqlTot "select strata,sum(qty) as tobedone from $tabT group by strata order by strata"
set code {
set sql "select count(*) from $tabPj where ouid = 8 and strata = $rec(strata)"
set num [::yadb::getTuple $db $sql 0]
if {$num == -1} {return -1}
if {$type == 1} {set num [expr $rec(tobedone) - $num]}
lappend res $rec(strata) $num
}
if {[::yadb::pgSelect $db $sqlTot rec $code] < 0} {
return -1
}
return $res
}
# quota checking for Cod col - soglia
#
# @param db database connection handler
# @param idPj project's id on db.
# @param type integer that specify if yuo want
# numerosita' or distanza dall'obiettivo.
# @return quota list, -1 on generic error.
proc ::admin::quotaCodColS {db idPj type} {
# NOT YET IMPLEMENTED -- TO BE DONE
return [list]
set res [list]
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return -1}
set tabPj $dataPj(pjtable)
set tabT $dataPj(pjtable_theo)
set sqlTot ""
set code {
set sql ""
set num [::yadb::getTuple $db $sql 0]
if {$num == -1} {return -1}
if {$type == 1} {set num [expr $rec(numero) - $num]}
lappend res $rec(strato) $num
}
if {[::yadb::pgSelect $db $sqlTot rec $code] < 0} {
return -1
}
return $res
}
# import the sampling structure from a specified
# formatted file
#
# @param db (sampling) database connection handler
# @param idPj project's id on db
# @param path file's path
# return 0 on success; -1 on error
proc ::admin::importSampleStructure {db idPj path} {
if {$idPj == -1 || $path == ""} {
::yalog::error "invalid project's id and/or path"
return -1
}
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return -1}
set tab $dataPj(pjtable_theo)
set tys $dataPj(sampling_type)
set fieldL ""
switch -exact -- $tys \
$::sample::COD_PROV_CAPOLUO {set fieldL [list cod_prov qty_capo qty_not_capo label]}\
$::sample::RUOTATO {set fieldL [list pop,strata,qty,label]}\
$::sample::COD_COL {set fieldL [list strata qty label]}\
$::sample::SOST {set fieldL [list kindof strata qty]}\
$::sample::COD_COL_POP_RES {set fieldL [list strata qty_pop qty_not_pop label]}\
default {
::yalog::error "invalid sampling type"
return -1
}
#first we've to emty sample design table
if {[::yadb::execl $db "delete from $tab"]==-1} {
::yalog::error "unable to empty $tab"
return -1
}
if {[::yadb::importFile $db $tab $path $fieldL]==-1} {
::yalog::error "bad file $path; the file must be tab separeted"
return -1
}
return 0
}
# Get a project start-end timestamp to use as performance
# osservation period.
# @param (sample) db database connectoin handler
# @param pj project's id
# return a two timestamps (start and end) list; -1 on error.
proc ::admin::getAllPjOss {db pj} {
set times [::yadb::getTuple $db "select pjstart, pjend from projects.projects where proj=$pj" 0]
if {$times == -1} {
::yalog::error "error on searching for project's start and end"
return -1
}
set start [lindex $times 0]
set end [lindex $times 1]
set firstTurnStart [lindex [::yadb::getTuple $db "select tstart from projects.turns t, projects.tupjs i \
where t.idt=i.idt \
order by day, tstart" 0] 0]
set lastTurnEnd [lindex [::yadb::getTuple $db "select tend from projects.turns t, projects.tupjs i where t.idt=i.idt \
order by day desc, tend desc" 0] 0]
if {$firstTurnStart == -1 || $lastTurnEnd == -1} {
::yalog::error "cannot get project's first (and|or) last turn(s)"
return -1
}
return [::yadb::getTuple $db "select date('$start') + '$firstTurnStart'::time, \
date('$end') + '$lastTurnEnd'::time" 0]
}
# summarize the project status calculating
# some indexes.
#
# @param db - database connection handler
# @param idPj project's id on db.
# @param fromHere [optional] where do you want to start to calculate performance indexes?
# @param toHere [optional] where do you want to stop to calculate performance indexes?
# @return indexs' list, -1 on generic error.
# The result list's composed as below:
# - # completed quests
# - # left quests
# - # unused contacts
# - # call backs
# - list of four performance indexes
# respectively for completed, refused,
# call backs and others
# - list of mean performance indexes.
proc ::admin::summarize {db idPj {fromHere ""} {toHere ""}} {
set res [list]
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {return -1}
set tab $dataPj(pjtable)
set tabT $dataPj(pjtable_theo)
set samplet $dataPj(sampling_type)
set completed [yadb::getTuple $db "select count(*) from $tab where ouid=8" 0]
if {$completed == -1} {return -1}
set left 0
switch -- $samplet {
0 {
set tot [lindex [yadb::getTuple $db "select sum(qty_capo + qty_not_capo) from $tabT" 0] 0]
}
1 -
2 -
4 {
set tot [lindex [yadb::getTuple $db "select sum(qty) from $tabT" 0] 0]
}
3 { set tot "Lista" }
5 {
set tot [lindex [yadb::getTuple $db "select sum(qty_pop + qty_not_pop) from $tabT" 0] 0]
}
default {
set tot 0
}
}
if {$tot == -1} {return -1}
if {$tot != "Lista" } {
set left [expr $tot - $completed]
} else {
set left ""
}
set unused [lindex [::yadb::getTuple $db "select count(*) from $tab where touch is null and quota = false\
and locked=false and ouid is null" 0] 0]
if {$unused == -1} {return -1}
set callbacks [lindex [::yadb::getTuple $db "select count(*) from projects.schedule where proj=$idPj" 0] 0]
if {$callbacks == -1} {return -1}
# perfomance indexes calculation
set performance [list 0 0 0 0]
#NB add new outcomes like (sms and email)
set performance_state [list [list 8] [list 6] [list 7 9] [list 1 2 3 4 5]]
if {$fromHere != "" && $toHere != ""} {
::yalog::debug "starting calculating performance indexes"
# get operetors ids and their worked hours.
set resbb [::bbtools::bb_work_hard $db $idPj $fromHere $toHere]
if {$resbb == -1} {return -1}
set ops [lindex $resbb 1]
set hls [lindex $resbb 0]
# how many hours has been spent?
set hlsum 0
for {set i 0} {$i < [llength $hls]} {incr i} {
set hlsum [expr $hlsum + [lindex $hls $i]]
}
if {$hlsum == 0} {set hlsum 1}
::yalog::debug "#operators: [llength $ops]"
::yalog::debug "total hours worked (all ops' summed): $hlsum"
# calculate each performance index
set ossPeriod [::bbtools::ossPeriod $db $idPj $fromHere $toHere]
set performance [::bbtools::bb-mean $db $idPj $performance_state $fromHere $toHere \
$ops $hlsum $ossPeriod]
if {$performance==-1} {
::yalog::error "unable to get avg performance idxes for projects $idPj "
return -1
}
lappend performance [llength $ops]
set meanPerformance [list]
for {set i 0} {$i < 4} {incr i} {
set p [lindex $performance $i]
lappend meanPerformance [format "%.1f" [expr double($p/$hlsum)]]
}
lappend meanPerformance [lindex $performance 4]
lappend meanPerformance [lindex $performance 5]
lappend meanPerformance [lindex $performance 6]
}
lappend res $completed $left $unused $callbacks $performance $meanPerformance
}
# get the time a user has spent for a project
# in a specific work turn starting from start
# and ending not after end.
#
# @param db operators database connection handler
# @param idPj project's id on db
# @param op which operator are you looking for?
# @param start when does this turn start?
# @param end upper limit for turn ending (i.e. the next turn's start)
# @return time amount for the turn; -1 on error.
proc ::admin::turnTime {db idPj op start end} {
set s [admin::getStatTable $db $idPj]
if {$s < 0} {return $s}
# look for the turn's end
set endSql "select end_work from $s where start_work is null and end_work > '$start' and uid=$op and proj=$idPj"
if {$end != ""} {
set endSql "$endSql and end_work < '$end'"
}
set endSql "$endSql order by end_work"
set numEnd [yadb::getNumTuples $db $endSql]
if {$numEnd > 0} {
set endT [lindex [yadb::getTuple $db $endSql 0] 0]
} else {
if {$end != ""} {
set endT [lindex [yadb::getTuple $db "select max(end_work) from $s where end_work > '$start'\
and end_work < '$end' and uid=$op and proj=$idPj" 0] 0]
} else {
set date [lindex [yadb::getTuple $db "select date('$start')" 0] 0]
if {$date == -1} {return -1}
set endT [lindex [yadb::getTuple $db "select max(end_work) from $s where date(end_work)=$date \
and end_work > '$start' and uid=$op and proj=$idPj" 0] 0]
}
}
if {$endT == -1} {return -1}
return [lindex [yadb::getTuple $db "select '$endT' - '$start'::timestamp" 0] 0]
}
# get the time a user has spent on a project
#
# @param db operators database connection handler
# @param idPj project's id
# @param op which operator are you going to "process"
# @return time amounts; -1 on error.
proc ::admin::timeSpent {db idPj op} {
set s [admin::getStatTable $db $idPj]
if {$s == -1} {return -1}
# retrive all op's "begin"
set startSql "select start_work from $s where uid=$op and proj=$idPj\
and end_work is null and cod_com is null and rid is null order by start_work"
set work_time 0
set start_work [list]
set code {lappend start_list $rec(start_work)}
if {[yadb::pgSelect $db $startSql rec $code] < 0} {
return -1
}
# for each "begin" find the corresponding amount
# of time using the turnTime proc.
for {set i 0} {$i < [llength $start_list] } {incr i} {
set this_time [lindex $start_list $i]
# if I'm on the last "begin" I don't need to have end_time
# because I'll take the last one (and there is no element
# corresponding to lindex $start_list [expr $i + 1])
if {$i != [expr [llength $start_list] - 1]} {
set end_time [lindex $start_list [expr $i + 1]]
} else {
set end_time ""
}
set tot [admin::turnTime $db $idPj $op $this_time $end_time]
set approx "0"
if { ("$tot" == "-1") } {
# some error occurs...we're going
# to approximate this value so we'll
# this using the approx flag
set tot "00:00:00"
set approx "1"
}
if {$i != 0} {
set work_time [yadb::getTuple $db "select '$work_time'+ '$tot'::interval" 0]
if {$work_time == -1} {return -1}
} else {
set work_time $tot
}
}
set work_time [yadb::getTuple $db "select extract(epoch FROM '$work_time seconds'::interval)/3600" 0]
if {$work_time == -1} {return -1}
set work_time [format %.2f $work_time]
# this has to be internationalize!!!
# here we're changing . in , on real
# number.
regsub -all \\. $work_time \, work_time
return [list $work_time $approx]
}
# countStateForOp - counts how many contacts has been marked
# with a specifed state(s) by an operator.
#
# @param db (operators) database connection handler
# @param idPj project's id
# @param op operator's id
# @param state state you want to match
# @return how many contacts has been classified as 'state'
# from operators op in project idPj
proc ::admin::countStateForOp {db idPj op state} {
set s [admin::getStatTable $db $idPj]
if {$s == -1} {return -1}
return [lindex [yadb::getTuple $db "select count(*) from $s where uid=$op and proj=$idPj and ouid=$state" 0] 0]
}
# getFieldList - gives you back two list of field/type of table tab
#
# @param db - db connections handler (sample)
# @param tab - table whose yuo eant two know the list of fields
# @return a list of fields, -1 on error
proc ::admin::getFieldLIst {db schema tab} {
set qry "SELECT column_name,data_type,character_maximum_length \
FROM information_schema.columns \
WHERE table_name='$tab' and table_schema='$schema'\
ORDER BY ordinal_position"
set cmd {
set name $rec(column_name)
lappend dselect "$name"
}
set dselect [list]
set res [::yadb::pgSelect $db $qry rec $cmd]
if {$res<0} {
::yalog::error "Not able to retrive $tab table structure!"
return -1
}
return $dselect
}
# importFile - import file into table pj projects
#
# @param db - db connection handler
# @param idPj - project id
# @param slist - field list to import
# @param path - file where contatcs are stored
# @return 0 on success, -1 on db error, -2 on sanity check error
proc ::admin::importFile {db idPj slist path} {
# copiare i nominativi in una tab temporanea
set tmpt "projects.a[clock seconds]"
set slistp [join $slist ","]
if {[::yadb::execl $db "create table $tmpt (like projects.template including defaults)"] == -1} {
::yalog::error "Error while creating aux table $tmpt"
return -1
}
if {[::yadb::importFile $db $tmpt $path $slist] == -1} {
::yalog::error "Error while importing contacts from $path into $tmpt"
return -1
}
# check for duplicate id
set uqry "select rid,count(*) from $tmpt group by rid having count(*) >1"
set nuqry [::yadb::getNumTuples $db $uqry]
if {$nuqry == -1} {
::yalog::error "db error occurs while check rid uniqueness"
return -1
}
if {$nuqry > 1} {
::yalog::error "Find duplicate index while importing contatcs"
return -2
}
# check for duplicate id on both table
array set dataPj [::admin::getDataPj $db $idPj]
if {[array size dataPj] == 0} {
::yalog::error "unable to retrive pj data by id"
return -1
}
set uqry_gob "select rid,count(*) \
from (select rid from $tmpt union all select rid from $dataPj(pjtable)) as a \
group by rid \
having count(*) > 1"
set nuqry_gob [::yadb::getNumTuples $db $uqry_gob]
if {$nuqry_gob == -1} {
::yalog::error "db error occurs while check id uniqueness"
return -1
}
if {$nuqry_gob > 1} {
::yalog::error "Find duplicate index while importing contatcs"
return -2
}
# append new contacts to pj table
if {[::yadb::execl $db "insert into $dataPj(pjtable) select * from $tmpt"] == -1} {
::yalog::error "db error occurs while copyng new contacts on $pjtable"
return -1
}
if {[::yadb::execl $db "drop table $tmpt"] == -1} {
::yalog::error "db error occurs while dropping $tmpt"
return -1
}
return 0
}
proc ::admin::getSmsTxt {db proj} {
return [lindex [::yadb::getTuple $db "select btrim(smstxt) \
from projects.projects where proj=$proj" 0] 0]
}
# ::admin::setLia update lia data for a given project
#
# @param db database connection handler
# @param pj the project you're working on
# @param email email template data
# @param invite panel invite template data
# @param sms sms template data
# @param fax fax template data
# @param return 0 on success; -1 on error.
proc ::admin::setLia {db pj email invite sms fax} {
set sql "select mtime from projects.projects_lia where proj=$pj"
set mode 0
if {[::yadb::getNumTuples $db $sql] == 1} {set mode 1}
if {$mode == 0} {
set sql "insert into projects.projects_lia \
(proj, email_template, invite_template, sms_text, fax_template, mtime) \
values ($pj, [pg_quote $email], [pg_quote $invite], [pg_quote $sms], '[pg_escape_bytea $fax]', now())"
} else {
set sql "update projects.projects_lia set email_template = [pg_quote $email], \
invite_template = [pg_quote $invite], sms_text = [pg_quote $sms], fax_template = '[pg_escape_bytea $fax]', \
mtime = now() where proj=$pj"
}
return [::yadb::execl $db $sql]
}
# get a project contacts' history into an array
# whose keys are contacts' rid. Each array element
# is an array with these keys: cod_com, uid, login,
# ts, ouid, name.
proc ::admin::build_history {db proj proj_table} {
set s [admin::getStatTable $db $proj]
set sql "select p.rid as rid , p.cod_com as cod, \
case when auto_call = 0 then p.uid else -1 end as uid, \
case when auto_call = 0 then login else 'auto' end as login, \
extract (epoch from start_work) as ts, p.ouid, t.name \
from $s p, interviewers.interviewers i, $proj_table t \
where p.uid = i.uid and p.rid = t.rid and \
proj = $proj and p.ouid > 0 \
order by ts"
array set res [list]
set cmd {
catch {array unset mytmp}
array set mytmp [list]
set mytmp(cod_com) $rec(cod)
set mytmp(uid) $rec(uid)
set mytmp(login) $rec(login)
set mytmp(ts) $rec(ts)
set mytmp(ouid) $rec(ouid)
set mytmp(name) $rec(name)
if {[info exists res($rec(rid))]} {
set new $res($rec(rid))
set this [array get mytmp]
lappend new $this
} else {
set new [list [array get mytmp]]
}
set res($rec(rid)) $new
}
if {[::yadb::pgSelect $db $sql rec $cmd] < 0} {
return [list]
}
return [array get res]
}
Index by: file name |
procedure name |
procedure call |
annotation
File generated 2008-03-25 at 02:51.