Created
July 18, 2009 16:11
-
-
Save zed9h/149603 to your computer and use it in GitHub Desktop.
semi-automatic scheduler for rio int'l film festival, former riocine
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/bin/bash | |
mkdir -p site | |
cd site | |
for i in $(seq 1 99) | |
do | |
file=$(printf list%02d.html $i) | |
url="http://www.festivaldoriobr.com.br/f2005/web/seleciona_filmes2.asp?search=%25&escolha=1&aprovado=LIBERADO&id_diretor=%25&id_cinema=0&id_dia=0&id_mostra=0&page=$i" | |
wget -c -O $file $url | |
grep id_filme $file || break | |
done | |
# <td class="class4"><A href="filme.asp?id_filme=227">A Legítima esposa</a> | |
for i in $( sed -n "s/.*id_filme=\([0-9]\+\).*/\1/p" list*.html) | |
do | |
file=$(printf film%03d.html $i) | |
url="http://www.festivaldoriobr.com.br/f2005/web/filme.asp?id_filme=$i" | |
wget -c -O $file $url | |
done |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
my $movie; | |
my $session; | |
my $dir=shift || "site"; | |
my %out; | |
if(open F, glob("ignore.txt")) { | |
while(<F>) { | |
$out{$_}++; | |
} | |
close F; | |
} | |
my $accent = do "accent.data" or die $!; | |
sub norm($) { | |
local $_ = shift; | |
s/\&(.).*?\;/$1/g; | |
s/\&\#(\d+)\;/ my $c=chr($1); defined($accent->{$c}) ? $accent->{$c} : $c /eg; | |
s/./ defined($accent->{$&}) ? $accent->{$&} : $& /eg; | |
s/[\r\n]+/ /g; #? | |
s/^\s+//; s/\s+$//; | |
$_ | |
} | |
opendir D, "$dir" || die "$!"; | |
foreach my $file ( sort grep /^film\d+\.html/, readdir D ) { | |
print STDERR "$dir/$file ... "; | |
open F, "$dir/$file" || die "$!"; | |
undef $/; | |
$_ = <F>; | |
close F; | |
my $id = ($file =~ m/\d+/ && $&); | |
my $m={id=>$id}; | |
$m->{title_pt} = norm $1 | |
if m|<td class="headlines2">\s*(.*?)\s*</td>|ms; | |
$m->{title_orig} = norm $1 | |
if m|<td colspan="2" class="class4"><font size="2">Titulo Original: (.*?)\s*</font></td>|ms; | |
$m->{title_en} = norm $1 | |
if m|<td colspan="2"class="class4"><font size="2">Titulo\s+em Inglês: (.*?)\s*</font></td>|ms; | |
$m->{censorship} = norm $1 | |
if m|<td colspan="2" class="class4"><font size="2">Classificação:(.*?)\s*</font></td>|ms; | |
$m->{picture} = norm $1 | |
if m|<td height="33"><img src="fotos/(.*?)"></td>|ms; | |
%$m = (%$m, map { norm $_ } ( m|<td width="74" bordercolor="#FF0033"(?: height="9")? align="left" class="class4"><font size="2">(.*?):</font></td>\s+<td width="355"(?: height="9")?(?: bgcolor="#CCCCCC")?(?: height="9")? class="class4"><font size="2">(.*?)</font></td>|msg )); | |
($m->{plot_pt}, $m->{plot_en}, $m->{bio_pt}, $m->{bio_en}) = map { norm $_ } ( m|<td bordercolor="#CCCCCC" colspan="3" class="class4">\s+<div ALIGN="JUSTIFY"><font size="2">(.*?)</font></div>|msg ); | |
$m->{group} = norm $1 | |
if m|<td colspan="3" background="imagens/linha.gif" class="headlines" height="20"><font size="2">Mostra:\s*(.*?)</font></td>|ms; | |
@_ = map { norm $_ } m{ | |
<tr>\s+ | |
<td class="class4" valign="top"><font size="2"><img src="imagens/g_clear\.gif" width="8" height="8">(.*?)\s*-?\s*(\d+)/(\d+)/(\d+)</font></td>\s+ | |
<td class="class4"><font size="2"><img src="imagens/g_clear\.gif" width="8" height="8">(.*?)</font></td>\s+ | |
<td class="class4"><font size="2"><img src="imagens/g_clear\.gif" width="8" height="8">(\d+)(?::(\d+))?\s*hs </font></td>\s+ | |
<td class="class4"><font size="2">(.*?)\s*</font></td>\s+ | |
</tr>}msg; | |
print STDERR "sessoes ", scalar(@_), "\n"; | |
while (@_) { | |
my $wday=shift @_; | |
my $mday=shift @_; | |
my $mon=shift @_; | |
my $year=shift @_; | |
my $theater=shift @_; | |
my $hour=shift @_; | |
my $min=shift(@_) || "00"; | |
my $code=shift @_ || "$theater $mon-$mday $hour:$min"; | |
$m->{session_count}++; | |
$m->{session} | |
->{$year}->{$mon}->{$mday} | |
->{$hour}->{$min} | |
->{$theater} = $code; | |
my $ss = $session->{$code}||={}; | |
$ss->{mon}=$mon; | |
$ss->{day}=$mday; | |
$ss->{hour}=$hour; | |
$ss->{min}=$min; | |
$ss->{theater}=$theater; | |
$ss->{len}+=$m->{Duracao}; | |
push @{$ss->{movie}}, $m; | |
} | |
$movie->{$id}=$m if exists $m->{session}; | |
} | |
#TODO dont rotate it they are equal (size/md5?) | |
#rename "riocine.pm.2", "riocine.pm.3" || die "$!"; | |
#rename "riocine.pm.1", "riocine.pm.2" || die "$!"; | |
#rename "riocine.pm", "riocine.pm.1" || die "$!"; | |
open F, ">riocine.pm" || die "$!"; | |
use Data::Dumper; | |
$Data::Dumper::Indent=1; | |
print F "package riocine;\n"; | |
print F "our (\$movie, \$session);\n"; | |
print F Data::Dumper->Dump( | |
[$movie, $session, ], | |
['movie', 'session', ]); | |
print F "1;\n"; | |
close F; | |
print STDERR "./riocine.pm written.\n"; | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use riocine; | |
my $accent = do "accent.data"; | |
sub norm($) { | |
local $_ = shift; | |
s/./ defined($accent->{$&}) ? $accent->{$&} : $& /eg; | |
s/^(.*),\s*(\S*?)$/$2 $1/i; | |
s/[^a-z0-9']+/ /gi; | |
s/^\s+//; s/\s+$//; | |
lc $_ | |
} | |
my $m = $riocine::movie; | |
my $ref={}; | |
foreach my $id (keys %$m) { | |
my $rate = 0; | |
my $mm = $m->{$id}; | |
push @{$ref->{int $mm->{Ano}}->{norm $mm->{title_orig}}}, $id; | |
#printf STDERR "! %4d %s\n", int $mm->{Ano}, norm $mm->{title_orig}; | |
} | |
my $imdb={}; | |
print STDERR "reading ./ratings.list\n"; | |
open R, "ratings.list" || die "$!"; | |
while(<R>) { | |
last if ( /^MOVIE RATINGS REPORT/ ); | |
} | |
while(<R>) { | |
chomp; | |
# 0000011112 359 6.6 "'60s, The" (1999) (mini) | |
if(/^\s*([\.0-9\*]{10})\s+(\d+)\s+([0-9\.]+)\s+\"?(.*?)\"?\s+\((\d+)\)(?:\s+\(.*\))?\s*$/) { | |
my ($demo, $num, $rate, $title, $year) = ($1,$2,$3,$4,$5); | |
#printf STDERR "? %4d %s\n", int $year, norm $title; | |
my $t = norm $title; | |
my $y = int $year; | |
if(exists $ref->{$y}->{$t}) { | |
my $id = $ref->{$y}->{$t}; | |
printf STDERR "= %4d %s\n", int $year, norm $title; | |
foreach (@$id) { | |
$imdb->{$_} = { | |
rate=>$rate, | |
num_votes=>$num, | |
demo=>$demo, | |
title=>$title, | |
} | |
} | |
} | |
} | |
} | |
close R; | |
sub dumpfile($$) { | |
my $file = shift; | |
my $data = shift; | |
#TODO dont rotate it they are equal (site/md5?) | |
rename "$file.data.2", "$file.data.3" || die "$!"; | |
rename "$file.data.1", "$file.data.2" || die "$!"; | |
rename "$file.data", "$file.data.1" || die "$!"; | |
open F, ">$file.data" || die "$!"; | |
use Data::Dumper; | |
$Data::Dumper::Indent=1; | |
print F Data::Dumper->Dump([$data],[$file]); | |
close F; | |
print STDERR "./$file.data written.\n"; | |
} | |
dumpfile "imdb", $imdb; | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use riocine; | |
my $keyword = do("keyword.data") or die $!; | |
my $theater = do("theater.data") or die $!; | |
my $imdb = do("imdb.data") or die $!; | |
my $imdb_factor=5; | |
my $accent = do "accent.data" or die $!; | |
sub norm($) { | |
local $_ = shift; | |
s/./ defined($accent->{$&}) ? $accent->{$&} : $& /eg; | |
s/^\s+//; s/\s+$//; | |
$_ | |
} | |
my $m = $riocine::movie; | |
my $rating={}; | |
foreach my $id (keys %$m) { | |
my $rate = 0; | |
my $mm = $m->{$id}; | |
$rate += $rating->{$id}->{kw}->{imdb} | |
= int($imdb->{$id}->{rate} || 5) * $imdb_factor; | |
# print "$id $rate imdb $rating->{$id}->{kw}->{imdb}\n"; | |
foreach my $f (keys %$keyword) { | |
my $ff = $mm->{$f}; | |
foreach my $k (keys %{$keyword->{$f}}) { | |
my $pat = norm $k; | |
if($ff =~ /\b$pat/i) { | |
$rate += $rating->{$id}->{kw}->{"$f:$k"} | |
= $keyword->{$f}->{$k}; | |
# print "$id $rate $f:$k ".$rating->{$id}->{kw}->{"$f:$k"}."\n"; | |
} | |
} | |
} | |
# printf STDERR "%4.1f %20s | %s\n", ($rate, | |
# $m->{$id}->{Direcao}, | |
# $m->{$id}->{title_orig}, | |
# ); | |
#$m->{$id}->{rate} = $rate; | |
$rating->{$id}->{rate} = $rate; | |
foreach my $Y (keys %{$mm->{session}}) { | |
foreach my $M (keys %{$mm->{session}->{$Y}}) { | |
foreach my $D (keys %{$mm->{session}->{$Y}->{$M}}) { | |
foreach my $h (keys %{$mm->{session}->{$Y}->{$M}->{$D}}) { | |
foreach my $m (keys %{$mm->{session}->{$Y}->{$M}->{$D}->{$h}}) { | |
foreach my $r (keys %{$mm->{session}->{$Y}->{$M}->{$D}->{$h}->{$m}}) { | |
$theater->{$r}=0 unless exists $theater->{$r}; | |
}}}}}} | |
} | |
sub dumpfile($$) { | |
my $file = shift; | |
my $data = shift; | |
#TODO dont rotate it they are equal (site/md5?) | |
rename "$file.data.2", "$file.data.3" || die "$!"; | |
rename "$file.data.1", "$file.data.2" || die "$!"; | |
rename "$file.data", "$file.data.1" || die "$!"; | |
open F, ">$file.data" || die "$!"; | |
use Data::Dumper; | |
$Data::Dumper::Indent=1; | |
print F Data::Dumper->Dump([$data],[$file]); | |
close F; | |
print STDERR "./$file.data written.\n"; | |
} | |
dumpfile "rating", $rating; | |
dumpfile "theater", $theater; # add new theaters | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
system "./3dig"; #TODO only re-rate if keywords.data weights changed | |
use riocine; | |
my $keyword = do("keyword.data") or die $!; | |
my $theater = do("theater.data") or die $!; | |
my $rating = do("rating.data") or die $!; | |
my $imdb = do("imdb.data") or die $!; | |
die "insuficient data" unless $keyword && $theater && $rating && $imdb; | |
my $m = $riocine::movie; | |
my $rat = $rating || $imdb; #rating mix imdb already | |
my @id = | |
# sort {norm($m->{$a}->{title_pt}) cmp norm($m->{$b}->{title_pt})} # alt | |
sort {$rat->{$b}->{rate} <=> $rat->{$a}->{rate}} | |
grep {$rat->{$_}->{rate} >= 10} #strict | |
keys %$rat; | |
sub short($) { | |
local $_ = shift; | |
s/^competicao de curtas (\d): //i; | |
s/^curta hors concours: //i; | |
s/^(A|O|Um|Uma|As|Os|Uns|Umas) (.)(.*)$/uc($2)."$3, $1"/ei; | |
$_ | |
} | |
sub norm($) { | |
local $_ = short shift; | |
#anythingelse? | |
lc $_ | |
} | |
open TXT, ">rating.txt" || die "$!"; | |
select TXT; | |
sub imdb_link($) { | |
local $_ = shift; | |
s/\s/+/g; | |
s/[^a-z0-9\+]/sprintf "%%%02x", ord($&)/ige; | |
"http://us.imdb.com/Title?$_"; | |
} | |
use Text::Wrap; | |
$Text::Wrap::columns=65; | |
my $i; | |
if(1) { | |
$i=0; | |
printf "%3s %4s %4s %s %s\n", qw(idx rate imdb name +keywords); | |
foreach my $id (@id) { | |
# printf "%03d %4d %s %s\n", | |
# printf "%03d %4d %4s %-40s %s %s\n", | |
printf "%03d %4d %4s %s %s\n", | |
++$i, | |
$rat->{$id}->{rate}, | |
defined($imdb->{$id}->{rate}) ? | |
sprintf("%4.1f", $imdb->{$id}->{rate}) : "", | |
# $m->{$id}->{Ano}, | |
short $m->{$id}->{title_pt}, | |
# $m->{$id}->{title_orig}, | |
# imdb_link($imdb->{$id}->{title}), | |
join(' ',map { | |
"$rat->{$id}->{kw}->{$_}=$_" } keys %{$rat->{$id}->{kw}||{}}), | |
#($rat->{$id}->{kw}->{$_} > 0 ? '+':'-' ).$_ } grep {$_ ne 'imdb'} keys %{$rat->{$id}->{kw}||{}}), | |
; | |
} | |
print "\n",'#' x 60, "\n\n"; | |
} | |
$i=0; | |
foreach my $id (@id) { | |
my $mm = $m->{$id}; | |
printf "%s [%4d] %04d\n", '=' x 50, $rat->{$id}->{rate}, ++$i; | |
print "$m->{$id}->{group}", "\n"; | |
print wrap("","",short($mm->{title_pt}), "\"$mm->{title_orig}\"", $mm->{Direcao}, $mm->{Ano}, $mm->{Pais}, $mm->{Duracao}), "\n"; | |
if($imdb->{$id}->{rate}) { | |
printf "IMDB: %4.1f (%d votes) %s (%% votes per notes [0-10])\n", | |
$imdb->{$id}->{rate}, | |
$imdb->{$id}->{num_votes}, | |
$imdb->{$id}->{demo}, | |
; | |
print " ",imdb_link($imdb->{$id}->{title}),"\n"; | |
} | |
print wrap("ELENCO: "," ",$mm->{Elenco}), "\n"; | |
print wrap("RESUMO: "," ",$mm->{plot_pt}), "\n"; | |
print wrap("DIRETOR: "," ",$mm->{bio_pt}), "\n"; | |
my $s = $mm->{session}; | |
foreach my $Y (sort {$a<=>$b} keys %{$s}) { | |
foreach my $M (sort {$a<=>$b} keys %{$s->{$Y}}) { | |
foreach my $D (sort {$a<=>$b} keys %{$s->{$Y}->{$M}}) { | |
foreach my $h (sort {$a<=>$b} keys %{$s->{$Y}->{$M}->{$D}}) { | |
foreach my $m (sort {$a<=>$b} keys %{$s->{$Y}->{$M}->{$D}->{$h}}) { | |
foreach my $t (sort {$a<=>$b} keys %{$s->{$Y}->{$M}->{$D}->{$h}->{$m}}) { | |
my $c = $s->{$Y}->{$M}->{$D}->{$h}->{$m}->{$t}; | |
print wrap("HORARIO: "," ","$Y-$M-$D $h:$m $c $t"), | |
(($theater->{$t} ||= 0) < 0.5 ? "*" : ""), | |
"\n"; | |
}}}}}} | |
} | |
close TXT; | |
print STDERR "./rating.txt written.\n"; | |
select STDOUT; | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
my $redig = | |
(-M 'keyword.data') < (-M 'schedule.txt') || | |
(-M 'theater.data') < (-M 'schedule.txt'); | |
system "./3dig" if $redig; | |
use riocine; | |
my $rating = do ("rating.data") or die $!; | |
my $imdb = do ("imdb.data") or die $!; | |
my $theater = do ("theater.data") or die $!; | |
my $rat = $rating;# || $imdb; #rating mix imdb already | |
my $min_rate = 30; # 10; | |
my $m = $riocine::movie; | |
my $enable = { | |
debug_map=>0, | |
excluded=>1, | |
session=>1, | |
ticket=>1, | |
}; | |
sub short($) { #title_pt | |
local $_ = shift; | |
s/^competicao de curtas (\d): //i; | |
s/^curta hors concours: //i; | |
s/^(A|O|Um|Uma|As|Os|Uns|Umas) (.)(.*)$/uc($2)."$3, $1"/ei; | |
$_ | |
} | |
# feedback | |
if(!$redig) { | |
print STDERR "reading schedule.txt\n"; | |
my $keyword = do ("keyword.data") or die $!; | |
open TXT, "schedule.txt" || die "$!"; | |
sub apply_rate_change($$) | |
{ | |
my ($rate, $title_pt) = @_; | |
# TODO detect redundant keywords, like multiple title substrings (?) | |
my ($id) = grep {short($riocine::movie->{$_}->{title_pt}) eq short($title_pt)} | |
keys %$riocine::movie; | |
return unless $id; | |
$title_pt = $riocine::movie->{$id}->{title_pt}; # not-norm | |
$rate -= $rating->{$id}->{rate}; | |
return unless $rate; | |
$rating->{$id}->{rate} += $rate; | |
$rating->{$id}->{kw}->{"title_pt:$title_pt"} += $rate; | |
$keyword->{title_pt}->{$title_pt} += $rate; | |
print " CHANGE: $id $title_pt += $rate\n"; | |
} | |
while(<TXT>) { | |
chomp; | |
#002 Sat 09-27 17:00 Espaco Unibanco 2 UN093 57.1 Teknolust 85' | |
#001 Fri 09-26 24:00 Estacao Botafogo 1 EB006 -7.0 Comp. Curtas 1: "Amor So de Mae" 21'; 4.8 Jovem Adao, O 99' | |
#024 Mon 10-06 22:00 Espaco Unibanco 2 UN149 46 Interstella 5555 67' | |
if(/^\d{3} [A-Z][a-z]{2} \d{2}-\d{2} \d{2}:\d{2} .{20} [A-Z]{2}[0-9]{3} ((?:\s*[\-\d]+ .*? \d+')+)$/) { | |
foreach (split /;\s*/, $1) { | |
/([\-\d]+) (.*?) \d+'/ && apply_rate_change $1,$2; | |
} | |
} | |
#*** 104.0 MARCO TULLIO GIORDANA 2003 Melhor da Juventude - Parte 2, O | |
# 3.0 Sam Green, Bill Siegel 2003 Tempo de Protesto | |
#elsif(/^(?:\*{3})?\s*([\d\.]+) .*? \d{4} \[(.*?)\]$/) { | |
#elsif(/^(?:\*{3})?\s*([\d\.]+) \[(.*?)\] \d{4} .*?$/) { | |
elsif(/^\s*([\-\d]+) \[(.*?)\] \d+/) { | |
apply_rate_change $1,$2; | |
} | |
} | |
close TXT; | |
sub dumpfile($$) { | |
my $file = shift; | |
my $data = shift; | |
#TODO dont rotate it they are equal (site/md5?) | |
rename "$file.data.2", "$file.data.3" || die "$!"; | |
rename "$file.data.1", "$file.data.2" || die "$!"; | |
rename "$file.data", "$file.data.1" || die "$!"; | |
open F, ">$file.data" || die "$!"; | |
use Data::Dumper; | |
$Data::Dumper::Indent=1; | |
print F Data::Dumper->Dump([$data],[$file]); | |
close F; | |
print STDERR "./$file.data written.\n"; | |
} | |
dumpfile "rating", $rating; | |
dumpfile "keyword", $keyword; | |
} | |
# output | |
rename "schedule.txt.4", "schedule.txt.5"; | |
rename "schedule.txt.3", "schedule.txt.4"; | |
rename "schedule.txt.2", "schedule.txt.3"; | |
rename "schedule.txt.1", "schedule.txt.2"; | |
rename "schedule.txt", "schedule.txt.1"; | |
open TXT, ">schedule.txt" || die "$!"; | |
select TXT; | |
sub norm($) { #session_code | |
local $_ = shift; | |
m/OD|JF|MAM|PL/ && 5 or | |
m/SL|PA/ && 3 or | |
m/UN|CB|EB/ && 1 or | |
m/RX|LB|IP/ && -5 or | |
-10 | |
} | |
#print STDERR "rating count: ", scalar(keys %$rat), "\n"; | |
#print STDERR "minimum rate: ", $min_rate, "\n"; | |
my $candidate; | |
foreach my $id ( | |
sort {$rat->{$b}->{rate} <=> $rat->{$a}->{rate}} | |
grep {$rat->{$_}->{rate} > $min_rate} | |
keys %$rat | |
) { | |
my $mm = $m->{$id}; | |
my $s = $mm->{session}; | |
foreach my $Y (keys %{$s}) { | |
foreach my $M (keys %{$s->{$Y}}) { | |
foreach my $D ( | |
#grep {$_ != 25} #janja | |
keys %{$s->{$Y}->{$M}}) { | |
foreach my $h ( | |
grep {$_ >= 16 && $_ < 24 || $rat->{$id}->{rate} > 200} #sono | |
# grep {$_ >= 19 && $_ <= 21} | |
keys %{$s->{$Y}->{$M}->{$D}}) { | |
foreach my $m ( | |
#grep {$h > 16 || $_ >= 30} #sono | |
keys %{$s->{$Y}->{$M}->{$D}->{$h}}) { | |
foreach my $t (keys %{$s->{$Y}->{$M}->{$D}->{$h}->{$m}}) { | |
my $cod = $s->{$Y}->{$M}->{$D}->{$h}->{$m}->{$t}; | |
my $prio = | |
$rat->{$id}->{rate} + #rating | |
1-$mm->{session_count}/10 + #less sessions | |
1-abs(norm($a))/10 + #closer to core (?) | |
$theater->{$t} + #place rating | |
$h/24 + #later in day | |
($h<16 ? (16-$h) * -10 : 0) + #not too early | |
($h<13 ? (13-$h) * -50 : 0) + #not too early | |
0; | |
next if $prio < 0; | |
push @{$candidate->{$prio}}, $cod; | |
# print "$prio: $dd $hh $mm->{title_pt}\n"; | |
}}}}}} | |
} | |
my $s = $riocine::session; | |
my $map={}; | |
my $schedule={}; | |
my $place={}; | |
sub insert($;$) { | |
my $c = shift; | |
my $force = shift; | |
my $ss = $s->{$c}; | |
return unless $ss; | |
return if $ss->{allocated}; | |
return if $ss->{movie}->[0]->{allocated}; | |
my $dd = "$ss->{mon}-$ss->{day}"; | |
my $hh = "$ss->{hour}:$ss->{min}"; | |
my $st = int(($ss->{hour}*60+$s->{min})/10); | |
my $en = $st + int($ss->{len}/10)+1; | |
unless($force) { | |
# print "0: $c\n"; | |
for my $d (4,3,2,1,0) { # time/distance hit? | |
# print "A($st,$en,$d):", @{$map->{$dd}}{($st-$d)..($en+$d)}, "\n"; | |
# print "B:", (grep {$_ && abs(norm($_) - norm($c)) >= $d} | |
# @{$map->{$dd}}{($st-$d)..($en+$d)}), "\n"; | |
return if | |
grep {$_ && abs(norm($_) - norm($c)) >= $d} | |
@{$map->{$dd}}{($st-$d)..($en+$d)}; | |
} | |
} | |
# print "=Ok\n"; | |
@{$map->{$dd}}{$st..$en} = ( | |
$c,$c,$c,$c,$c,$c, # 60min | |
$c,$c,$c,$c,$c,$c, #120min | |
$c,$c,$c,$c,$c,$c, | |
$c,$c,$c,$c,$c,$c, #240min | |
$c,$c,$c,$c,$c,$c, | |
$c,$c,$c,$c,$c,$c,); | |
$ss->{allocated}=1; | |
foreach my $mm (@{$ss->{movie}}) { | |
$mm->{allocated}=$c; | |
} | |
$schedule->{$dd}->{$hh}=$c; | |
push @{$place->{$ss->{theater}}},$c; | |
} | |
foreach my $p (sort {$b<=>$a} keys %{$candidate}) { | |
foreach my $c (sort @{$candidate->{$p}}) { | |
insert $c; | |
} } | |
if(open INS, "insert.txt") { | |
while (<INS>) { | |
chomp; | |
next unless $_; | |
insert $_, 1; | |
} | |
close INS; | |
} | |
#debug map | |
if($enable->{debug_map}) { | |
foreach my $d (sort keys %$map) { | |
foreach my $h (sort {$a<=>$b} keys %{$map->{$d}}) { | |
my $c = $map->{$d}->{$h}; | |
next unless $c; | |
printf "%5s %03d0m %s %s\n", | |
$d, $h, $c, | |
join "; ", | |
map { | |
short($_->{title_pt})." ($_->{Duracao})" | |
} | |
sort {$a->{Duracao} <=> $b->{Duracao}} | |
@{$s->{$c}->{movie}}; | |
} } | |
print "\n",'=' x 60,"\n\n"; | |
}#if(0) | |
#exclusion verification | |
if($enable->{excluded}) { | |
print uc "excluded\n"; | |
foreach my $id ( | |
sort {$rat->{$b}->{rate} <=> $rat->{$a}->{rate}} | |
grep {$rat->{$_}->{rate} > $min_rate*.8 && !$m->{$_}->{allocated}} | |
keys %$rat | |
) { | |
my $mm = $m->{$id}; | |
# print "*** " if $rat->{$id}->{rate} > $min_rate; | |
# printf "%4d %20s %4s [%s]\n", | |
printf "%4d [%s] %4d %s\n", | |
$rat->{$id}->{rate}, | |
short($mm->{title_pt}), | |
$mm->{Ano}, | |
$mm->{Direcao}, | |
; | |
local $_ = $mm->{plot_pt}; | |
s/\b(?:n[ao]|[ao]|ao?|e|sua|seu|uma?|cuj[ao]|numa?)s?\b\s*//ig; | |
s/\b(?:d[aoe]|que|pa?ra|como?|se|mas)\b\s*//ig; | |
s/\b(?:mais|foi|tem|ja)\b\s*//ig; | |
s/\.\s*[,;.]/\./ig; | |
use Text::Wrap; $Text::Wrap::columns=75; | |
my $pre = ' ' x 5; | |
$_ = wrap($pre,$pre,$_); | |
s/^((?:.*?\n){2}.*?)\n.*$/$1 ::/ms; | |
print "$_\n"; | |
} | |
print "\n",'=' x 60,"\n\n"; | |
}#if(0) | |
#session list | |
sub imdb_link($) { | |
local $_ = shift; | |
s/\s/+/g; | |
s/[^a-z0-9\+]/sprintf "%%%02x", ord($&)/ige; | |
"http://us.imdb.com/Title?$_"; | |
} | |
if($enable->{session}) { | |
print "SESSION LIST (order by datetime)\n\n"; | |
my $i=0; | |
foreach my $d (sort keys %$schedule) { | |
my $last=undef; | |
use Time::Local; | |
$d =~ /-/; | |
my $wday = (qw(Sun Mon Tue Wed Thu Fri Sat)) | |
[(localtime(timelocal(0,0,0,$',$`-1,(localtime)[5])))[6]]; | |
print "--- $wday $d -------------------------------------\n"; | |
foreach my $h (sort keys %{$schedule->{$d}}) { | |
my $c = $schedule->{$d}->{$h}; | |
#if($last && norm($last) ne norm($c)) { | |
if($last) { | |
my $c0 = $riocine::session->{$last}; | |
my $c1 = $riocine::session->{$c}; | |
my $st = $c0->{hour}*60 + $c0->{min} + $c0->{len}; | |
my $en = $c1->{hour}*60 + $c1->{min}; | |
my $gap = $en - $st; | |
my $exp = 10*abs(norm($last) - norm($c)); # expected | |
if($gap < $exp - 5 || $gap > $exp + 45) { | |
$gap = sprintf("%dh%02d",int($gap/60),$gap%60) if $gap>60; | |
$exp = sprintf("%dh%02d",int($exp/60),$exp%60) if $exp>60; | |
$exp = $exp ? ", and need ${exp}m" : ""; | |
print "------------ (${gap}m${exp})\n" | |
} | |
} | |
printf "%03d %3s %5s %5s %20s %s %s\n", | |
++$i, $wday, $d, $h, | |
$riocine::session->{$c}->{theater}, substr($c,0,5), | |
join ";", | |
map { | |
# sprintf("%s %d'", | |
sprintf("%4d %s %d'", | |
$rat->{$_->{id}}->{rate}, | |
short($_->{title_pt}), | |
$_->{Duracao}, | |
) | |
} | |
sort {$a->{Duracao} <=> $b->{Duracao}} | |
@{$s->{$c}->{movie}}; | |
if(0) { #imdb link | |
foreach ( | |
grep {$imdb->{$_->{id}}->{title}} | |
sort {$a->{Duracao} <=> $b->{Duracao}} | |
@{$s->{$c}->{movie}} | |
) { | |
print " ",imdb_link($imdb->{$_->{id}}->{title}),"\n"; | |
} | |
} | |
$last = $c | |
} | |
print "\n"; | |
} | |
print "\n",'=' x 60,"\n\n"; | |
}#if(0) | |
#ticket list | |
if($enable->{ticket}) { | |
print "TICKET BUY LIST (order by theater)\n\n"; | |
my $i=0; | |
foreach my $t (sort keys %$place) { | |
print '-'x60,"\n"; | |
foreach my $c (sort @{$place->{$t}}) { | |
my $ss = $riocine::session->{$c}; | |
use Time::Local; | |
my $wday = (qw(Sun Mon Tue Wed Thu Fri Sat)) | |
[(localtime(timelocal(0,0,0, | |
$ss->{day},$ss->{mon}-1,(localtime)[5])))[6]]; | |
printf "%03d %3s %02d-%02d %02d:%02d %20s %s %s\n", | |
++$i, $wday, | |
$ss->{mon}, $ss->{day}, | |
$ss->{hour}, $ss->{min}, | |
$ss->{theater}, $c, | |
join ";", | |
map { | |
sprintf("%s %d'", | |
short($_->{title_pt}), | |
$_->{Duracao} | |
) | |
} | |
sort {$a->{Duracao} <=> $b->{Duracao}} | |
@{$ss->{movie}}; | |
} | |
print "\n"; | |
} | |
}#if(0) | |
close DATA; | |
close TXT; | |
print STDERR "./schedule.txt written.\n"; | |
select STDOUT; |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use riocine; | |
my $theater = do("theater.data") or die $!; | |
sub short($) { | |
local $_ = shift; | |
s/.*?\bcurtas?\b.*?: //i; | |
s/^(A|O|Um|Uma|As|Os|Uns|Umas) (.)(.*)$/uc($2)."$3, $1"/ei; | |
$_ | |
} | |
my $mm = $riocine::movie; | |
my $plain=1; | |
# FIXME not showing when more than one movie share the same session :(( | |
my $cc = {}; # session by code | |
my $dd = {}; # session by time | |
foreach my $id (sort {short($mm->{$a}->{title_pt}) cmp short($mm->{$b}->{title_pt})} keys %$mm) { | |
my $mmm = $mm->{$id}; | |
# print "TITULO: $mmm->{title_pt}\n" if $plain; | |
my $s = $mmm->{session}; | |
foreach my $Y (sort {$a<=>$b} keys %{$s}) { | |
foreach my $M (sort {$a<=>$b} keys %{$s->{$Y}}) { | |
foreach my $D (sort {$a<=>$b} keys %{$s->{$Y}->{$M}}) { | |
foreach my $h (sort {$a<=>$b} keys %{$s->{$Y}->{$M}->{$D}}) { | |
foreach my $m (sort {$a<=>$b} keys %{$s->{$Y}->{$M}->{$D}->{$h}}) { | |
foreach my $t (sort {$a cmp $b} keys %{$s->{$Y}->{$M}->{$D}->{$h}->{$m}}) { | |
next unless $theater->{$t} > 0; | |
my $cod = $s->{$Y}->{$M}->{$D}->{$h}->{$m}->{$t}; | |
my $ccc = $cc->{$cod} ||= {}; | |
$ccc->{$id} ||= ++$mmm->{n}; | |
$dd->{$Y}->{$M}->{$D}->{$t}->{$h}->{$m} ||= $cod; | |
# print "HORARIO: $Y-$M-$D $h:$m $cod $t\n" if $plain; | |
}}}}}} | |
} | |
foreach my $Y (sort {$a<=>$b} keys %{$dd}) { | |
foreach my $M (sort {$a<=>$b} keys %{$dd->{$Y}}) { | |
foreach my $D (sort {$a<=>$b} keys %{$dd->{$Y}->{$M}}) { | |
print "----\n"; | |
foreach my $t (sort {$a<=>$b} keys %{$dd->{$Y}->{$M}->{$D}}) { | |
foreach my $h (sort {$a<=>$b} keys %{$dd->{$Y}->{$M}->{$D}->{$t}}) { | |
foreach my $m (sort {$a<=>$b} keys %{$dd->{$Y}->{$M}->{$D}->{$t}->{$h}}) { | |
my $cod = $dd->{$Y}->{$M}->{$D}->{$t}->{$h}->{$m}; | |
my $ccc = $cc->{$cod}; | |
printf "%4d-%02d-%02d %2d:%02d %5s %s\n", | |
$Y,$M,$D,$h,$m,$cod, | |
join("; ", | |
map { "$mm->{$_}->{title_pt} $mm->{$_}->{Duracao} $ccc->{$_}/$mm->{$_}->{n}"} | |
sort {int($mm->{$b}->{Duracao}) <=> int($mm->{$a}->{Duracao})} | |
keys %{$ccc||{}} | |
); | |
}}}}}} | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
$accent = { | |
'á'=>'a','ä'=>'a','à'=>'a','â'=>'a','ã'=>'a', 'å'=>'a', | |
'é'=>'e','ë'=>'e','è'=>'e','ê'=>'e', | |
'í'=>'i','ï'=>'i','ì'=>'i','î'=>'i', | |
'ó'=>'o','ö'=>'o','ò'=>'o','ô'=>'o','õ'=>'o', | |
'ú'=>'u','ü'=>'u','ù'=>'u','û'=>'u', | |
'ý'=>'y','ÿ'=>'y', | |
'ç'=>'c', 'ñ'=>'n', | |
'Á'=>'A','Ä'=>'A','À'=>'A','Â'=>'A','Ã'=>'A', 'Å'=>'A', | |
'É'=>'E','Ë'=>'E','È'=>'E','Ê'=>'E', | |
'Í'=>'I','Ï'=>'I','Ì'=>'I','Î'=>'I', | |
'Ó'=>'O','Ö'=>'O','Ò'=>'O','Ô'=>'O','Õ'=>'O', | |
'Ú'=>'U','Ü'=>'U','Ù'=>'U','Û'=>'U', | |
'Ý'=>'Y',''=>'Y', | |
'Ç'=>'C', 'Ñ'=>'N', | |
chr(0x91)=>'\'', | |
chr(0x92)=>'\'', | |
chr(0xE6)=>'ae', | |
chr(0xF8)=>'\'', | |
chr(0x93)=>'"', | |
chr(0x94)=>'"', | |
chr(0xB2)=>'2', | |
chr(0xB3)=>'3', | |
chr(0xAA)=>'a', | |
chr(0xBA)=>'o', | |
chr(0xB0)=>'o', | |
chr(0xDF)=>'b', | |
chr(0x96)=>'-', | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment