[Consol] El programita que genera los horarios...
Gunnar Wolf
gwolf at campus.iztacala.unam.mx
Thu Jan 23 09:09:49 CST 2003
Me gustó lo suficiente como para compartirlo con quien pueda interesarle
;-)
-------------------------------------------------INICIA CÓDIGO
#!/bin/sh
echo ¡Cuidado!_revise_con_un_antivirus_antes_de_abrir_.175384
exit
#!/usr/bin/perl -w
use strict;
use HTML::Table;
use CGI qw(:standard);
use DBI;
use IO::File;
my ($dbh, $sth, @pon, @dias, %tracks, %horas, %color, $liga);
$dbh = DBI->connect("dbi:Pg:dbname=consol_03",'randrade','',
{RaiseError=>1, AutoCommit=>0}) or
die "Error abriendo comunicacion con la BD: $! $@";
$sth = $dbh->prepare("SELECT po.titulo, pe.nombre ||' '|| pe.apellidos,
po.id_track, po.id_forma_presentacion FROM persona pe, ponencia po
WHERE po.id_ponente=pe.id_persona AND po.id_ponencia = ?") or
die "Error preparando consulta en la BD: $! $@";
@dias = (['mie', 'Miércoles', '5 de febrero'],
['jue', 'Jueves', '6 de febrero'],
['vie', 'Viernes', '7 de febrero'],
['sab', 'Sábado', '8 de febrero']);
$liga = p({-align=>'center'}, join ' - ',
map {a({-href=>"${dias[$_][0]}-prog.html"},$dias[$_][1])}
(0..3) );
%tracks = map {$_->[0]=>$_->[1]} @{$dbh->selectall_arrayref(
'SELECT id_track, descripcion FROM track')} or
die "Error recuperando la lista de tracks: $! $@";
%color = (1=>'#DDDDFF', 2=>'#DDFFDD', 3=>'#DDFFFF', 4=>'#FFDDDD', 5=>'#FFDDFF');
%horas = (0=>'9:00', 1=>'11:00', 2=>'14:30', 3=>'16:00', 4=>'17:15', 5=>'18:15',
6=>'19:30', d1=>'10:50', d2=>'13:00', d4=>'1700', d6=>'19:15');
# Estructura:
# @norm (ponencias normales) consta de ([mie], [jue], [vie], [sab]).
# Para @norm, cada uno de estos arreglos contiene:
# [a, b, c, d, e, f, g]
# para cada uno de los horarios. Y cada uno de los elementos de horarios es:
# - Para talleres, tutoriales y conferencias normales (a, b, d, e, f):
# [ID, ID, ID, ID, ID, ID, ID, ID]
# lo cual corresponde a cada uno de los salones - Primero las tres aulas
# de computo, luego los cuatro auditorios normales, y por ultimo el auditorio
# principal.
# Los talleres solo pueden ir en los tres primeros salones.
# En el caso de los talleres y tutoriales matutinos, si la ponencia es de
# 4hr, SOLO la acepta en (a) y si el hueco correspondiente en (b) esta
# vacio. Si la ponencia es de 2hr, solo la acepta en (a) o (b). Si alguna
# de estas condiciones no se cumple, el programa se muere.
# Para marcar un espacio como vacio, va undef.
#
# Para ponencias magistrales, va el ID unicamente.
@pon = ( [
[46, 144, 62, 142, 32, 34, 48, undef],
[undef, undef, undef, 44, undef, 43, undef, undef],
undef,
[undef, undef, undef, 152, 146, 40, 138, 52],
[undef, undef, undef, 140, undef, 61, 53, 58],
[undef, undef, undef, 56, 35, 112, 55, 143],
148
], [
[39, 130, 94, undef, 50, 96, undef, undef],
[undef, undef, undef, 125, undef, 135, 114, undef],
149,
[undef, undef, undef, 122, 63, 65, 72, 75],
[undef, undef, undef, 64, 81, 109, 66, 84],
[undef, undef, undef, 74, 82, 83, 70, 108],
undef
], [
[68, 95, 98, 89, 86, 79, 69, undef],
[undef, undef, undef, 76, 120, undef, 104, undef],
107,
[undef, undef, undef, 85, 118, 126, 103, 123],
[undef, undef, undef, undef, 99, 111, 116, 121],
[undef, undef, undef, 102, 97, 115, 119, 124],
150
], [
[100, 128, 47, 57, 77, 93, 60, undef],
[undef, undef, undef, 71, 155, 110, undef, undef],
151,
[undef, undef, undef, 127, undef, 131, 49, 134],
[undef, undef, undef, 129, 136, 139, undef, 133],
[undef, undef, undef, undef, 153, undef, 132, 137],
147
]);
foreach my $dia (0..3) {
my $file = "cont/${dias[$dia][0]}-prog.html";
my $fh = IO::File->new($file,'w') or
die "Error abriendo $file: $! $@";
gen_dia($fh, $pon[$dia], $dia);
$fh->close;
}
$sth->finish;
$dbh->disconnect;
exit 0;
sub gen_dia {
my ($fh, $p, $dia, $tab, @taller);
$fh = shift;
$p = shift;
$dia = shift;
$fh->print(h3('Programa de ponencias'),
p(b('Nota importante: '), 'Este programa es aún ',
i('preliminar '), 'y está sujeto a cambios sin previo aviso.'),
$liga, h3({-align=>'center'}, "$dias[$dia][1] $dias[$dia][2]"));
$tab = HTML::Table->new(-border=>1);
$tab->addRow('Hora', 'Salón A', 'Salón B', 'Salón C', 'Auditorio 1',
'Auditorio 2', 'Auditorio 3', 'Auditorio 4',
'Auditorio principal');
foreach my $hora (0..6) {
# Agregamos a la tabla los descansos cuando toque...
if ($hora == 1 or $hora == 4 or $hora == 6) {
$tab->addRow($horas{"d$hora"}, 'Descanso');
} elsif ($hora == 2) {
$tab->addRow($horas{"d$hora"}, 'Comida');
}
if ($hora == 2 or $hora == 6) {
my ($txt);
my $id = $p->[$hora];
if (defined $id) {
$sth->execute($id) or
die "Error ejecutando consulta: $! $@";
my @row = $sth->fetchrow_array or
die "Error consultando BD: $! $@";
$txt = b($row[1]) . ': ' . a({-href=>"/cgi-bin/reg/lista_pon.pl?estado=mono&id_ponencia=$id"}, $row[0]);
} else {
$txt = 'Por confirmar';
}
$tab->addRow($horas{$hora},
"Conferencia magistral: $txt");
next;
}
# Inicializo los colores a blanco, los voy sobreescribiendo
my @data = ();
my @cols = ('#FFFFFF', '#FFFFFF', '#FFFFFF', '#FFFFFF',
'#FFFFFF', '#FFFFFF', '#FFFFFF', '#FFFFFF');
foreach my $aula (0..7) {
my $id = $p->[$hora][$aula];
$sth->execute($id);
my @row = $sth->fetchrow_array;
die "La ponencia larga en el aula $aula, día $dia, no cabe - $id, $taller[$aula]" if ($hora==1 and $id and $taller[$aula]);
if (!@row) {
# Para colorear/rellenar el segundo bloque de un
# taller/tutorial largo
if ($hora==1 and defined $taller[$aula]) {
@row = ('Continúa...',' ',
$taller[$aula], 1);
$cols[$aula] = $color{$taller[$aula]};
} elsif ($id) {
die "Error consultando BD en día $dia, hora $hora, aula $aula: $! $@";
} else {
# No, no hace falta nada, es un undef
}
}
if ($hora==0 and defined $row[3] and $row[3]!=2) {
$taller[$aula] = $row[2];
}
die "La ponencia a las $horas{$hora}, aula $aula, día $dia es de tipo incorrecto" if (
$id and (($hora==0 and $row[3]>3) or ($hora==1
and $row[3]!=2) or ($hora>2 and $row[3]<4) or
($hora==2 || $hora==6 and $row[3]!=8)));
if (!defined $id) {
push(@data, ' ');
next;
}
push(@data, a({-href=>"/cgi-bin/reg/lista_pon.pl?estado=mono&id_ponencia=$id"}, $row[0]) .
br . $row[1]);
$cols[$aula] = $color{$row[2]};
}
$tab->addRow($horas{$hora}, @data);
map {$tab->setCellBGColor($tab->getTableRows,$_,$cols[$_-2])}
(2..$tab->getTableCols);
}
$tab->addRow('21:00', 'Fin de actividades');
$tab->setRowHead(1);
$tab->setColHead(1);
map {$tab->setCellColSpan($_,2,$tab->getTableCols-1)}
(3, 5, 6, 8, 11, 12, 13);
map {$tab->setCellBGColor($_,2,'#00FF99')} (3, 5, 8, 11, 13);
map {$tab->setCellBGColor($_,2,'#FFFF99')} (6, 12);
map {$tab->setRowAlign($_,'center');
$tab->setRowVAlign($_,'top')} (1..12);
$fh->print($tab->getTable, $liga);
return 1;
}
-------------------------------------------------TERMINA CÓDIGO
Sale, nos vemos, voy a pagar el boleto ;-)
--
Gunnar Wolf - gwolf at campus.iztacala.unam.mx - (+52-55)5623-1118
PGP key 1024D/8BB527AF 2001-10-23
Fingerprint: 0C79 D2D1 2C4E 9CE4 5973 F800 D80E F35A 8BB5 27AF
_______________________________________________
CONSOL mailing list
CONSOL at consol.org.mx
http://tlali.iztacala.unam.mx/mailman/listinfo/consol
Politicas de las listas: http://tlali.iztacala.unam.mx/politicas/#listas
More information about the Consol
mailing list