#!/usr/bin/perl require 5.004; use Tk 800.000; use warnings; use strict; use Tk; # require installation use Tk::NoteBook; use Tk::LabFrame; use Tk::TableMatrix; # require installation use IO::File; use File::Temp; use POSIX; use utf8; use Unicode::Normalize; use Tk::Tree; # require installation use Storable; # require installation use DBI; use DBD::mysql; use Tk::Dialog; use Tk::TableMatrix::SpreadsheetHideRows; use constant { true => 0, false =>0, }; my $version = '1.1'; # definir les options par defaut my $fichier_config = 'Utiliser le fichier de configuration existant' ; my $action = 'Creer une nouvelle selection'; my $type_num = "CanalSat"; # my $type_num ; my @recuperateur= (0,'Aucun', 'Aucun', 'Aucun'); my $my_grab; my $message; my $fenetre_message; my @sel_chaine; my %ma_selection =( ); my @list_chaines =( ); my %configuration = ( ); my %bouquets = ( ); my @liste_node; my $ck_bt = {}; my @source_mythtv ; my %stat ; my %ColValue; my @liste_source_selectionne= (1,2,3); my $fenetre_source; my %liste_source_selectionne; my %test; my %source_bouquet; my %donnee_mythtv; #my $ans; # my $SourceMythtv = 0; #my $question =0 ; my @liste_source; my %compteur_bd_mythtv; my $WriteXmltvid; my $WriteIcone; my $base_initial; sub mettre_a_jour (); sub Recherche_source_mythtv (); #*************************************************************************** # Definition de l'empacement des fichiers de sauvegarde et de configuration - location to the configuration file et ouput file. #*************************************************************************** my $home = $ENV{HOME}; $home = '.' if not defined $home; my $conf_dir = "$home/.mythtv"; (-d $conf_dir) or mkdir($conf_dir, 0777) or die "cannot mkdir $conf_dir: $!"; my $my_chaine_file ="$conf_dir/my_chaines"; my $ma_selection="$conf_dir/ma_selection"; my $file_donnee_mythtv = "$conf_dir/donnee_mythtv"; # definir l'emplacement du fichier de configuration my $config_file ="$conf_dir/chaines_fr"; # emplacement de sauvegarde des icones my $location = "$ENV{HOME}/.mythtv/icones" ; (-d $location) or mkdir($location, 0777) or die "cannot mkdir $location: $!"; #===================== # Programme principal #===================== # Création de la fenêtre my $fenetre_principale = new MainWindow( -title => 'Configurateur de chaines pour Mythtv ', -background => 'white', ); # Taille minimale de ma fenêtre $fenetre_principale->minsize( 1250, 720 ); #======================== # Menu de l'application #======================== my $menu_bar = $fenetre_principale->Menu( -type => "menubar", ); $fenetre_principale->configure( -menu => $menu_bar, ); # menu fichier avec sous menu my $menu_fichier = $menu_bar->cascade( -label => 'Fichier', -tearoff => 0, ); # $menu_fichier->command( -label => 'Nouveau', ); # $menu_fichier->command( -label => 'Ouvrir', -image => $fenetre_principale->Getimage("openfile"), -compound => "left"); $menu_fichier->command( -label => 'Enregistrer', -command => sub {sauvegarder($my_chaine_file);} ); # $menu_fichier->command( -label => 'enregistrer sous', ); # my $cascade1 = $menu_fichier->cascade( -label => 'cascade 1', -tearoff => 0, ); # $cascade1->command( -label => 'test', ); $menu_fichier->separator; $menu_fichier->command( -label => 'Quitter', -command => sub { exit;} ); # menu chaines avec sous menu my $menu_chaine = $menu_bar->cascade( -label => 'Options', -tearoff => 0, ); $menu_chaine->command( -label => 'Mettre a jour le tableau', -command => sub { message(2) if (!$recuperateur[1]); afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num); }); $menu_chaine->command( -label => 'Effacer le tableau', -command => \&suppression_donnees_tableau ); $menu_chaine->command( -label => 'Effacer tout', -command => sub { %ma_selection= (); suppression_donnees_tableau (); foreach my $node (@liste_node) { my $node_name = (split('/', $node))[-1]; $node_name = $node if ($node_name eq ''); $ck_bt->{$node}->{checked} = 0; $ck_bt->{$node}->{reference}->configure(-background => 'white'); } }); # menu mythtv my $menu_mythtv = $menu_bar->cascade( -label => 'Mythtv', -tearoff => 0, ); $menu_mythtv->command( -label => 'Introduire les xmltvid dans MythTV',-command => sub { $WriteXmltvid = 1; $WriteIcone = 0 ; WriteDatabase (); }); $menu_mythtv->separator; $menu_mythtv->command( -label => 'Introduire les icones dans MythTV', -command => sub { $WriteXmltvid = 0 ; $WriteIcone = 1; WriteDatabase (); }); $menu_mythtv->separator; $menu_mythtv->command( -label => 'Introduire toutes les donnees dans MythTV', -command => sub { $WriteXmltvid = 1; $WriteIcone = 1; WriteDatabase (); }); # menu aide avec sous menu my $menu_aide = $menu_bar->cascade( -label => 'Aide', -tearoff => 0, ); $menu_aide->command( -label => 'Sous menu aide 1', ); $menu_aide->command( -label => 'Version', -command => sub { say("Configurateur de chaines TV \n\n\n Version $version \n\n\n Cree par Gilles Choteau \n\n\n gillessoixantequatorze\@orange.fr \n");} ); ######################## #création des onglets ######################## my $fenetre_onglets = $fenetre_principale->Frame( # -background => '#CCCCFF', )->pack(qw/-fill both -side left -expand 1 / ); my $blocnote = $fenetre_onglets->NoteBook( -backpagecolor => 'white', -bg => 'green', -inactivebackground => "white", )->pack(qw/-fill both -expand 1/); # creation des onglets my $onglet_configuration = $blocnote->add( "onglet_configuration", -label => "CONFIGURATION", ); my $onglet_selection = $blocnote->add( "onglet_selection", -label => "VOTRE SELECTION", ); my $onglet_statistique = $blocnote->add( "onglet_source", -label => "STATISTIQUES", ); ############## # onglet selection ############## my $title = "Choisissez les bouquets et les chaines que vous recevez"; # recharger la liste des bouquets sous forme de reference de hash %bouquets= %{retrieve('/home/gilles/.mythtv/config_file') }; #-------------------------------------------------------------------------- # creation de la zone de bouton et des boutons #-------------------------------------------------------------------------- my $buttonFrame = $onglet_selection->Frame(-height => '12', -relief => 'flat', -borderwidth => 0)->pack(-side => 'top', -fill => 'x', -anchor => 'n'); $buttonFrame->Label(-textvariable => \$title, -font => "{verdana} 8 {bold}", -foreground => 'RoyalBlue3', -background => 'green', -relief => 'flat', -borderwidth => 1, -anchor => 'w',)->pack(-side => 'left', -fill => 'both', -expand => 1); #-------------------------------------------------------------------------- # creation de la zone de l'arborescence #-------------------------------------------------------------------------- my $frame_arbre = $onglet_selection -> Frame(-relief => 'groove', -borderwidth => 1)->place ( -y=>18, -height => 650, -width=> 1250); my $zone_arbre = $onglet_selection->Frame(-relief => 'groove', -borderwidth => 1)->place ( -height => 650, -width=> 250); my $zone_tableau = $onglet_selection->Frame(-relief => 'groove', -borderwidth => 1)->place ( -x=>250, -height => 650, -width=> 1000); my $node_label = "node name"; my $ck_bt_value = 0; #-------------------------------------------------------------------------- # Creation de l'arborescence #-------------------------------------------------------------------------- my $bouquetstree = $zone_arbre->Scrolled( 'Tree', -background => 'white', -selectmode => 'extended', -selectbackground => 'LightGoldenrodYellow', -selectforeground => 'RoyalBlue3', -highlightthickness => 0, -font => 'verdana 8', -relief => 'flat', -scrollbars => 'osoe', -borderwidth => 0, -itemtype => 'window', -browsecmd => \&afficher_list_chaine )->pack(-side => 'left', -fill => 'both', -expand => 1, -anchor => 'w' ); #-------------------------------------------------------------------------- # Configuration additionelle de l'arborescence #-------------------------------------------------------------------------- $bouquetstree->configure(-separator => '/', -drawbranch => 'true', -indicator => 'true', -selectborderwidth => '0', -highlightcolor => 'LightGoldenrodYellow'); $bouquetstree->focus(); Remplir_arbre (); #-------------------------------------------------------------------------- # Remplissage du tableau ( tablematrix) #-------------------------------------------------------------------------- my $_data = {}; my ($rows,$cols) = (1,8); # nombre de ligne et de colonnes # definition des couleurs my %red = qw(-bg red -fg white); my %green = qw(-bg green -fg white); my %white = qw(-fg black); # creer le tableau des chaines my $liste_chaine = $zone_tableau->Scrolled ('TableMatrix' , -rows => $rows, -cols => $cols, -titlerows => 1, -titlecols => 1, -width => 8, -height => 8 , -colwidth => 3, -selectmode => 'extended', -variable => $_data, -cursor => 'top_left_arrow' , -borderwidth => 2 , -ipadx => 10, -scrollbars => 'se', # -multiline=> 0, -browsecommand => \&brscmd, )->pack(qw/-expand 1 -fill both/); # variable pour l'editeur de chaine my @ro =( ); my @but; my $visible; # commencer au debut de la liste liste_chaines ([]); ############## # onglet Configuration ############## # creation du titre my $title1 = "Configuration"; $buttonFrame = $onglet_configuration->Frame(-height => '20', -relief => 'flat', -borderwidth => 0)->pack(-side => 'top', -fill => 'x', -anchor => 'n'); $buttonFrame->Label(-textvariable => \$title1, -font => "{verdana} 10 {bold}", -foreground => 'RoyalBlue3', -background => 'green', -relief => 'flat', -borderwidth => 1, -anchor => 'w') ->pack(-side => 'top', -fill => 'x', -expand => 1); # creer la zone configuration generale my $zone_config = $onglet_configuration->Frame(-relief => 'groove', -borderwidth => 1)->place ( -height => 650, -width=> 400); my $label= $zone_config -> Label (-text => "\nConfiguration generale \n")-> pack(-side => 'top' ); #creation de la zone quoi faire my $zone_quoi= $zone_config->LabFrame(-labelside => 'acrosstop'); $zone_quoi= $zone_config->LabFrame(-label => "Que souhaitez-vous faire ?"); foreach ('Creer une nouvelle selection' ,'Modifier votre precedente selection','Utiliser les donnees de mythtv' ) { $zone_quoi->Radiobutton(-text => "$_", -variable => \$action, -value => "$_", -command => \&change_conf1 )->pack(-anchor => 'w'); } $zone_quoi ->place (-y=>100,-x => 20); #creation de la zone fichier de config my $fenetre_config= $zone_config->LabFrame(-labelside => 'acrosstop'); $fenetre_config= $zone_config->LabFrame(-label => "Quel fichier de configuration souhaitez-vous utiliser ?"); foreach ('Creer un nouveau fichier de configuration' ,'Utiliser le fichier de configuration existant' ) { $fenetre_config->Radiobutton(-text => "$_", -variable => \$fichier_config, -value => "$_", -command => \&change_conf )->pack(-anchor => 'w'); } $fenetre_config->place (-y=>300,-x => 20); #creation de la zone choix de numerotation my $zone_numero= $zone_config->LabFrame(-labelside => 'acrosstop'); $zone_numero= $zone_config->LabFrame(-label => "Quelle numerotation souhaitez-vous utiliser ?"); foreach ('CanalSat' ,'TNT', 'Aucun' ) { $zone_numero->Radiobutton(-text => "$_", -variable => \$type_num, -value => "$_", -command => \&change_conf )->pack(-anchor => 'w'); } $zone_numero->place (-y=>500,-x => 20); # creation de la zone recuperateur my $zone_recuperateur = $onglet_configuration->Frame(-relief => 'groove', -borderwidth => 1)->place ( -x=>400, -height => 650, -width=> 400); $label= $zone_recuperateur -> Label (-text => "\nChoisissez les recuperateurs de programmes \nque vous souhaitez utiliser")-> pack(-side => 'top' ); my %label; foreach my $i (1..3) { $label{$i}= $zone_recuperateur -> Label (-text => "")-> pack(-side => 'top' ); my %fenetre_recuperateur = ( ); $fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-labelside => 'acrosstop'); $fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-label => "Votre recuperateur de programmes principal " ) if ($i eq "1"); $fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-label => "Votre second recuperateur de programmes " ) if ($i eq "2"); $fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-label => "Votre troisieme recuperateur de programmes " ) if ($i eq "3"); foreach (qw/Kazer mc2xml Telepoche Telerama Iphone Aucun/) { $fenetre_recuperateur{$i}->Radiobutton(-text => "$_", -variable => \$recuperateur[$i], -value => "$_", -command => \&change_conf )->pack(-anchor => 'w'); } $fenetre_recuperateur{$i}->pack(-anchor => 'w',-padx => 50); } # creation de la zone de configuration de mythtv my $zone_config_mythtv = $onglet_configuration->Frame(-relief => 'groove', -borderwidth => 1)->place ( -x=>800, -height => 650, -width=> 450); $label= $zone_config_mythtv -> Label (-text => "\nConfiguration en rapport avec MythTV", # -font => '{Courrier New} 12 {bold}' )-> pack(-side => 'top' ); # mettre a jour suite au changement de configuration sub change_conf { #affiche les donnees dans la table (tablematrix) afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num ); } # mettre a jour suite au changement de configuration sub change_conf1 { message (1); # recharger la liste des bouquets sous forme de reference de hash %bouquets = ( ); %bouquets= %{retrieve('/home/gilles/.mythtv/config_file') } if $action eq 'Creer une nouvelle selection'; %bouquets= %{retrieve('/home/gilles/.mythtv/ma_selection') } if $action eq 'Modifier votre precedente selection'; if ($action eq 'Utiliser les donnees de mythtv' ){ %bouquets= %{retrieve('/home/gilles/.mythtv/config_file') }; creation_zone_conf_mythtv (@liste_source); ReadDatabase (); %bouquets= %{retrieve('/home/gilles/.mythtv/donnee_mythtv') } } Remplir_arbre(); #affiche les donnees dans la table (tablematrix) afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num ); $fenetre_message->destroy; } #==================== # onglet statistique #==================== my $liste_source= $onglet_statistique; my $label_chaine= $onglet_statistique -> Label (-text => "nombre de chaines selectionnees")-> place (-y=>50,-x => 20); my $lab_nbr_chaine= $onglet_statistique -> Label (-textvariable => \$stat{chaine_sel})-> place (-y=>50,-x => 400); my $label_numero= $onglet_statistique -> Label (-text => "nombre de chaines selectionnees et numerotees")-> place (-y=>70,-x => 20); my $lab_nbre_numero= $onglet_statistique -> Label (-textvariable => \$stat{numero} )-> place (-y=>70,-x => 400); my $label_xmltvid= $onglet_statistique -> Label (-text => "nombre de chaines selectionnees ayant un xmltvid")-> place (-y=>90,-x => 20); my $lab_nbre_xmltvid= $onglet_statistique -> Label (-textvariable => \$stat{xmltvid} )-> place (-y=>90,-x => 400); my $label_icone= $onglet_statistique -> Label (-text => "nombre de chaines selectionnees ayant une icone")-> place (-y=>110,-x => 20); my $lab_nbre_icone= $onglet_statistique -> Label (-textvariable => \$stat{icone} )-> place (-y=>110,-x => 400); my $label_modif_bd_xmltvid= $onglet_statistique -> Label (-text => "nombre de xmltvid modifie dans la base de donnee")-> place (-y=>150,-x => 20); my $lab_modif_bd_xmltvid= $onglet_statistique -> Label (-textvariable => \$compteur_bd_mythtv{xmltvid} )-> place (-y=>150,-x => 400); my $label_modif_bd_icone= $onglet_statistique -> Label (-text => "nombre d'icones modifie dans la base de donnee")-> place (-y=>170,-x => 20); my $lab_modif_bd_icone= $onglet_statistique -> Label (-textvariable => \$compteur_bd_mythtv{icone} )-> place (-y=>170,-x => 400); my $label_modif_bd_numero= $onglet_statistique -> Label (-text => "nombre de numero modifie dans la base de donnee")-> place (-y=>190,-x => 20); my $lab_modif_bd_numero= $onglet_statistique -> Label (-textvariable => \$compteur_bd_mythtv{numero} )-> place (-y=>190,-x => 400); my $label_modif_bd_callsign= $onglet_statistique -> Label (-text => "nombre de callsign modifie dans la base de donnee")-> place (-y=>210,-x => 20); my $lab_modif_bd_callsign= $onglet_statistique -> Label (-textvariable => \$compteur_bd_mythtv{callsign} )-> place (-y=>210,-x => 400); ############## # fenetre principale / bas de page ############## my $message_accueil = " Bienvenue dans le configurateur de chaines de Mythtv.fr "; # Affichage d'un texte my $label_accueil = $fenetre_onglets->Label( -text => $message_accueil, -background => 'white', )->pack(-side => 'left'); $lab_nbr_chaine= $fenetre_onglets -> Label (-textvariable => \$stat{chaine_sel},-background => 'green', -padx =>20)-> pack(-side => 'right' ); $label_chaine= $fenetre_onglets -> Label (-text => "nombre de chaines selectionnees")-> pack(-side => 'right' ); MainLoop(); # Obligatoire #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ # debut des sous-routines #---------------------------------------------------------- #---------------------------------------------------------- #subroutine -- votre selection #---------------------------------------------------------- # Remplissage de l'arborescence sub Remplir_arbre { @liste_node =( ); $ck_bt = {}; #creer la liste des nodes da l'arborescence for my $source (sort keys %bouquets) { push(@liste_node, "$source"); my @list_bouquets = sort keys %{$bouquets{$source}}; for my $bouquet (@list_bouquets) { push(@liste_node, "$source/$bouquet"); my @list_options = sort keys %{$bouquets{$source}{$bouquet}}; for my $option (@list_options) { push(@liste_node, "$source/$bouquet/$option"); @list_chaines = sort keys %{$bouquets{$source}{$bouquet}{$option}}; for my $chaine (@list_chaines) { push(@liste_node, "$source/$bouquet/$option/$chaine"); $ck_bt->{"$source/$bouquet/$option/$chaine"}->{checked}=0 ; $ck_bt->{"$source/$bouquet/$option"}->{checked}=0; $ck_bt->{"$source/$bouquet"}->{checked}=0; $ck_bt->{"$source"}->{checked}=0; # cocher les chaines qui le sont si celles-ci proviennent d'une selection existante ou de mythtv $ck_bt->{"$source/$bouquet/$option/$chaine"}->{checked}=1 if$bouquets{$source}{$bouquet}{$option}{$chaine}{cocher}eq 1; } } } } # effacer l'arborescence $bouquetstree->delete('all'); # recreer l'arborescence foreach my $node (@liste_node) { my $node_name = (split('/', $node))[-1]; $node_name = $node if ($node_name eq ''); my $ref = $bouquetstree->Checkbutton( -background => 'white', -activebackground => 'LightGoldenrodYellow', -highlightbackground => 'LightGoldenrodYellow', -activeforeground => 'RoyalBlue3', -text => "$node_name", -anchor => 'w', -variable => \$ck_bt->{$node}->{checked}, -command => [\&map_check_to_select, $node]); $ck_bt->{$node}->{reference} = $ref; $bouquetstree->add($node, -window, $ref); } $bouquetstree->autosetmode(); #fermer tous les nodes my $count =0; foreach my $node (@liste_node) { $bouquetstree->close($node); # if ($count < 1 and ($ck_bt->{$node}->{checked}eq 1) ){ if ($ck_bt->{$node}->{checked}eq 1 ){ map_check_to_select ( $node) ; $count ++; } } } # afficher la liste de chaine dans le tableau des chaines de l'onglet bouquet sub afficher_list_chaine { # suppress the indicator invocation here return if (caller(3))[3] eq 'Tk::Tree::IndicatorCmd'; &map_select_to_check($_[0]) unless (caller(1))[4]; # 0 - afficher_list_chaine called via eval from callback bound to HList # 1 - afficher_list_chaine called via function call &main::map_check_to_select $liste_chaine->deleteRows( 'end', 0); my @paths = $bouquetstree->info('selection'); my $seen = {}; my $chaine; %ma_selection =() ; $seen->{bouquet_de_base}=1; $seen->{bouquet_standard}=1; my ($nom_source, $nom_bouquet, $nom_option, $nom_chaine, $numero, $xmltvid, $icone, $sid) = ("","","","","","","","") ; LOOP: while (my $a = shift(@paths)) { if ($bouquetstree->info('children', $a)){ foreach my $b ($bouquetstree->info('children', $a)){ if ($bouquetstree->info('children', $b)){ next LOOP if ($seen->{$a} && $b); $seen->{$a}++ unless ($b); foreach my $c($bouquetstree->info('children', $b)){ if($bouquetstree->info('children', $c)){ next LOOP if ($seen->{$b} && $c); $seen->{$b}++ unless ($c); foreach my $d ($bouquetstree->info('children', $c)){ next LOOP if ($seen->{$c} && $d); $seen->{$c}++ unless ($d); ($nom_source, $nom_bouquet, $nom_option, $nom_chaine)= split(/\//, $d); next LOOP if ($seen->{$d}); $seen->{$d}++; $chaine =CleanNom ($nom_chaine); $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher}= 1; } }else{ my ($select1, $select2, $select3, $select4)= split(/\//, $c); if ($select4) { next LOOP if ($seen->{$c}); $seen->{$c}++; ($nom_source, $nom_bouquet, $nom_option, $nom_chaine) = ( $select1, $select2, $select3, $select4); $chaine =CleanNom ($nom_chaine); $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher}= 1; }elsif ($select3){ ($nom_source, $nom_bouquet, $nom_option, $nom_chaine) = ( $select1, $select2, '', $select3); next LOOP if ($seen->{$c}); $seen->{$c}++; $chaine =CleanNom ($nom_chaine); $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher}= 1; } } } }else{ next LOOP if ($bouquetstree->info('children', $b)); my ($select1, $select2, $select3, $select4)= split(/\//, $b); if ($select4) { ($nom_source, $nom_bouquet, $nom_option, $nom_chaine) = ( $select1, $select2, $select3, $select4); next LOOP if ($seen->{$b}); $seen->{$b}++; $chaine =CleanNom ($nom_chaine); $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher}= 1; }elsif ($select3){ ($nom_source, $nom_bouquet, $nom_option, $nom_chaine) = ( $select1, $select2, '', $select3); next LOOP if ($seen->{$b}); $seen->{$b}++; $chaine =CleanNom ($nom_chaine); $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher}= 1; } } } }else { my ($select1, $select2, $select3, $select4)= split(/\//, $a); if ($select4) { ($nom_source, $nom_bouquet, $nom_option, $nom_chaine) = ( $select1, $select2, $select3, $select4) ; next LOOP if ($seen->{$a}); $seen->{$a}++; $chaine =CleanNom ($nom_chaine); $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher}= 1 unless ($bouquetstree->info('children', $a)); }elsif ($select3&& !$select4){ ($nom_source, $nom_bouquet, $nom_option, $nom_chaine) = ( $select1, $select2, '', $select3); next LOOP if ($seen->{$a}); $seen->{$a}++; $chaine =CleanNom ($nom_chaine); $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher}= 1 unless ($bouquetstree->info('children', $a)); } } } #affiche les donnees dans la table (tablematrix) afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num); creation_zone_conf_mythtv (@liste_source_selectionne); return ; } # creation de la zone de configuration de mythtv sub creation_zone_conf_mythtv (){ my @liste_source = @_; $zone_config_mythtv->destroy if $zone_config_mythtv; $zone_config_mythtv = $onglet_configuration->Frame(-relief => 'groove', -borderwidth => 1)->place ( -x=>800, -height => 650, -width=> 450); $label= $zone_config_mythtv -> Label (-text => "\nConfiguration en rapport avec MythTV", # -font => '{Courrier New} 12 {bold}' )-> pack(-side => 'top' ); my $zone_text_mythtv = $zone_config_mythtv -> Text(-height => 3)->pack(); $zone_text_mythtv -> insert('end',"Afin que les donnees soient correctement introduites dans Mythtv, vous devez definir les bouquets recus par chaque source de Mythtv"); Recherche_source_mythtv (); my %fenetre_source; #afficher une table pour chaque source de mythtv foreach my $s_mythtv (@source_mythtv) { $fenetre_source{$s_mythtv}= $zone_config_mythtv->LabFrame(-label => "Bouquets recus par la source \"$s_mythtv\"", -labelside => 'acrosstop', )->pack( -anchor => 'w', -expand =>'1',-padx => 50); # afficher les source de la selection foreach my $s_select( @liste_source){ $fenetre_source{$s_mythtv}->Checkbutton(-text => $s_select, -command => sub { # enregistrer les choix effectues $source_bouquet{$s_select}= $s_mythtv; $source_bouquet{$s_mythtv} = $s_select if $source_bouquet{$s_select}; }) ->pack(-anchor => 'w'); } } } # mappage des boutons selectionnes sub map_check_to_select { if (my $parent2 = $bouquetstree->info('parent', $_[0])) { # $_[0] is a child node unless ($ck_bt->{$_[0]}->{checked}) { $ck_bt->{$_[0]}->{reference}->configure(-background => 'white'); $bouquetstree->selectionClear($_[0]); # as the child is not checked, the parents should not be checked, or selected ( $bouquetstree->selectionClear($parent2); $ck_bt->{$parent2}->{checked} = 0; $ck_bt->{$parent2}->{reference}->configure(-background => 'white'); # check each sibling, if any are checked, grey the parents node background # it is grey because we know at least one sibling, ($_[0]), is not checked # set checked siblings background to color of the list item selectio foreach ($bouquetstree->info('children', $parent2)) { if ($ck_bt->{$_}->{checked}){$bouquetstree->selectionSet($_);} if ($ck_bt->{$_}->{checked}){ $ck_bt->{$parent2}->{reference}->configure(-background => 'grey86'); if($ck_bt->{$_}->{checked}) {last}; }else{ foreach my $i ( $parent2){ $ck_bt->{$i}->{reference}->configure(-background => 'white'); } } } #si non selectionnes alors les enfants sont non selectionnes # pour les enfants de premier niveau &deselectionner_enfants } else { # if the child is checked, the parents should not be checked, or selected but grey $bouquetstree->selectionSet($_[0]); $ck_bt->{$_[0]}->{reference}->configure(-background => 'azure'); # if the child is checked, the parents should not be checked, or selected but grey foreach my $i ( $parent2) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; $ck_bt->{$i}->{reference}->configure(-background => 'white'); # check each sibling, if any are checked, grey the parent node background # it is grey because we know at least one sibling, ($_[0]), is not checked # set checked siblings background to color of the list item selection my $no_check = 0 ; foreach ($bouquetstree->info('children', $i)) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; $ck_bt->{$i}->{reference}->configure(-background => 'grey86'); unless ($ck_bt->{$_}->{checked}){ $no_check = $no_check + 1; }else{ if ($no_check eq '0') { $bouquetstree->selectionSet($i); $ck_bt->{$i}->{checked} = 1; $ck_bt->{$i}->{reference}->configure(-background => 'LightGoldenrodYellow'); } } } } } # la selection a des grands parents if (my $parent1 = $bouquetstree->info('parent', $parent2)) { unless ($ck_bt->{$_[0]}->{checked}) { $ck_bt->{$_[0]}->{reference}->configure(-background => 'white'); $bouquetstree->selectionClear($_[0]); # as the child is not checked, the parents should not be checked, or selected ( foreach my $i ( $parent1, $parent2) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; $ck_bt->{$i}->{reference}->configure(-background => 'white'); my ($reception,$bouquet,$option,$chaine) = split('/', $_[0]); $bouquets{$reception}{$bouquet}{$option}{$chaine}{cocher}= 0 if $chaine ; # check each sibling, if any are checked, grey the parents node background # it is grey because we know at least one sibling, ($_[0]), is not checked # set checked siblings background to color of the list item selection foreach ($bouquetstree->info('children', $i)) { if ($ck_bt->{$_}->{checked}){ $bouquetstree->selectionSet($_); foreach my $p( $parent2, $parent1){ $bouquetstree->selectionClear($i); $ck_bt->{$p}->{reference}->configure(-background => 'grey86'); } }else{ foreach my $l ( $parent1, $parent2){ $bouquetstree->selectionClear($i); $ck_bt->{$i}->{reference}->configure(-background => 'white'); } } } } #si non selectionnes alors les enfants sont non selectionnes # pour les enfants de premier niveau &deselectionner_enfants } else { # if the child is checked, the parents should not be checked, or selected but grey $bouquetstree->selectionSet($_[0]); $ck_bt->{$_[0]}->{reference}->configure(-background => 'LightGoldenrodYellow'); # if the child is checked, the parents should not be checked, or selected but grey foreach my $i ( $parent2, $parent1) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; # check each sibling, if any are checked, grey the parent node background # it is grey because we know at least one sibling, ($_[0]), is not checked # set checked siblings background to color of the list item selection my $no_check = 0 ; foreach ($bouquetstree->info('children', $i)) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; $ck_bt->{$i}->{reference}->configure(-background => 'grey86'); unless ($ck_bt->{$_}->{checked}){ $no_check = $no_check + 1; }else{ if ($no_check eq '0') { $bouquetstree->selectionSet($i); $ck_bt->{$i}->{checked} = 1; $ck_bt->{$i}->{reference}->configure(-background => 'LightGoldenrodYellow'); } } } } } # la selection a des arrieres grands parents if (my $parent0 = $bouquetstree->info('parent', $parent1)) { unless ($ck_bt->{$_[0]}->{checked}) { $ck_bt->{$_[0]}->{reference}->configure(-background => 'white'); $bouquetstree->selectionClear($_[0]); # as the child is not checked, the parents should not be checked, or selected ( foreach my $i ($parent0, $parent1, $parent2) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; $ck_bt->{$i}->{reference}->configure(-background => 'white'); # check each sibling, if any are checked, grey the parents node background # it is grey because we know at least one sibling, ($_[0]), is not checked # set checked siblings background to color of the list item selection foreach ($bouquetstree->info('children', $i)) { if ($ck_bt->{$_}->{checked}){ $bouquetstree->selectionSet($_); foreach my $i ($parent0, $parent1, $parent2){ $ck_bt->{$i}->{reference}->configure(-background => 'grey86'); } }else{ foreach my $i ($parent0, $parent1, $parent2){ $ck_bt->{$i}->{reference}->configure(-background => 'white'); } } } } } else { # if the child is checked, initialize the parent and the current node $_[0] to # checked and selected $bouquetstree->selectionSet($_[0]); $ck_bt->{$_[0]}->{reference}->configure(-background => 'LightGoldenrodYellow'); # if the child is checked, the parents should not be checked, or selected but grey foreach my $i ($parent2, $parent1, $parent0) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; $ck_bt->{$i}->{reference}->configure(-background => 'grey86'); # check each sibling, if any are checked, grey the parent node background # it is grey because we know at least one sibling, ($_[0]), is not checked # set checked siblings background to color of the list item selection my $no_check = 0 ; foreach ($bouquetstree->info('children', $i)) { $bouquetstree->selectionClear($i); $ck_bt->{$i}->{checked} = 0; $ck_bt->{$i}->{reference}->configure(-background => 'grey86'); unless ($ck_bt->{$_}->{checked}){ $no_check = $no_check + 1; }else{ if ($no_check eq '0') { $bouquetstree->selectionSet($i); $ck_bt->{$i}->{checked} = 1; $ck_bt->{$i}->{reference}->configure(-background => 'LightGoldenrodYellow'); } } } } } }else{ if ($ck_bt->{$_[0]}->{checked}) { &selectionner_enfants }else{ &deselectionner_enfants } } }else{ if ($ck_bt->{$_[0]}->{checked}) { &selectionner_enfants }else{ &deselectionner_enfants } } } else { # $_[0] is a top level node unless ($ck_bt->{$_[0]}->{checked}) { # if top level node is not checked, de-select it and un-check and de-selectd all child nodes &deselectionner_enfants } else { # if top level node is checked, select it and check and selectd all child nodes &selectionner_enfants } } &afficher_list_chaine; # get the data and display it } sub selectionner_enfants{ $ck_bt->{$_[0]}->{reference}->configure(-background => 'LightGoldenrodYellow'); $bouquetstree->selectionSet($_[0]); $ck_bt->{$_[0]}->{checked} = 1; # pour les enfants de premier niveau foreach ($bouquetstree->info('children', $_[0])) { $bouquetstree->selectionSet($_); $ck_bt->{$_}->{checked} = 1; $ck_bt->{$_}->{reference}->configure(-background => 'LightGoldenrodYellow'); # pour les enfants de second niveau foreach ($bouquetstree->info('children', $_)) { $ck_bt->{$_}->{checked} = 1; $bouquetstree->selectionSet($_); $ck_bt->{$_}->{reference}->configure(-background => 'LightGoldenrodYellow'); # pour les enfants de troisieme niveau foreach ($bouquetstree->info('children', $_)) { $ck_bt->{$_}->{checked} = 1; $bouquetstree->selectionSet($_); $ck_bt->{$_}->{reference}->configure(-background => 'LightGoldenrodYellow'); } } } } sub deselectionner_enfants { $ck_bt->{$_[0]}->{reference}->configure(-background => 'white'); $bouquetstree->selectionClear($_[0]); # pour les enfants de premier niveau foreach ($bouquetstree->info('children', $_[0])) { $ck_bt->{$_}->{checked} = 0; $ck_bt->{$_}->{reference}->configure(-background => 'white'); $bouquetstree->selectionClear($_); my ($reception,$bouquet,$option,$chaine) = split('/', $_); $bouquets{$reception}{$bouquet}{$option}{$chaine}{cocher}= 0 if $chaine; # pour les enfants de second niveau foreach ($bouquetstree->info('children', $_)) { $ck_bt->{$_}->{checked} = 0; $bouquetstree->selectionClear($_); $ck_bt->{$_}->{reference}->configure(-background => 'white'); my ($reception,$bouquet,$option,$chaine) = split('/', $_); $bouquets{$reception}{$bouquet}{$option}{$chaine}{cocher}= 0 if $chaine; # pour les enfants de troisieme niveau foreach ($bouquetstree->info('children', $_)) { $ck_bt->{$_}->{checked} = 0; $bouquetstree->selectionClear($_); $ck_bt->{$_}->{reference}->configure(-background => 'white'); my ($reception,$bouquet,$option,$chaine) = split('/', $_); $bouquets{$reception}{$bouquet}{$option}{$chaine}{cocher}= 0; } } } } # marquer les lignes selectionnees sub map_select_to_check { my $selection = shift; $ck_bt->{$selection}->{checked} = 1; $ck_bt->{$selection}->{reference}->configure(-background => 'LightGoldenrodYellow'); if (my $parent = $bouquetstree->info('parent', $selection)) { # is child # set parent node to not selected, un-checked, highlighted grey $bouquetstree->selectionClear($parent); $ck_bt->{$parent}->{checked} = 0; $ck_bt->{$parent}->{reference}->configure(-background => 'pink'); # if anything is checked, toplevel stays grey foreach my $q1 ($bouquetstree->info('children', $parent)) { return if (($q1 ne $selection) && (!($ck_bt->{$q1}->{checked}))); } # all children are selected, set parent node to selected, checked, highlighted yellow $bouquetstree->selectionSet($parent); $ck_bt->{$parent}->{checked} = 1; $ck_bt->{$parent}->{reference}->configure(-background => 'yellow'); } else { # is parent # make node selected and yellow highlight $ck_bt->{$selection}->{checked} = 1; $ck_bt->{$selection}->{reference}->configure(-background => 'yellow'); foreach my $q1 ($bouquetstree->info('children', $selection)) { $bouquetstree->selectionSet($q1); $ck_bt->{$q1}->{checked} = 1; $ck_bt->{$q1}->{reference}->configure(-background => 'yellow'); } } # iterate whole tree anything checked is marked selected foreach my $q ($bouquetstree->info('children')) { $bouquetstree->selectionSet($q) if ($ck_bt->{$q}->{checked}); $ck_bt->{$q}->{reference}->configure(-background => 'blue')if ($ck_bt->{$q}->{checked}); foreach my $q1 ($bouquetstree->info('children', $q)) { $bouquetstree->selectionSet($q1) if ($ck_bt->{$q1}->{checked}); $ck_bt->{$q1}->{reference}->configure(-background => 'blue')if ($ck_bt->{$q1}->{checked}); foreach my $q2 ($bouquetstree->info('children', $q)) { $bouquetstree->selectionSet($q2) if ($ck_bt->{$q2}->{checked}); $ck_bt->{$q2}->{reference}->configure(-background => 'green')if ($ck_bt->{$q2}->{checked}); } } } } # Supprimer les donnees de tablematrix sub suppression_donnees_tableau (){ # Calcul du nombre de ligne dans le tableau my $number_rows = $liste_chaine->cget( -rows ); #supprimer les lignes du tableau $liste_chaine->deleteRows ('0',"$number_rows"); } # afficher les donnees des chaines selectionnees sub afficher_ma_selection (){ #initialiser les variables my ($recup1,$recup2,$recup3,$type_n) =@_ ; message(2) if (!$recup1); $recup1= 1 unless $recup1; $recup2 = 1 unless $recup2; $recup3 = 1 unless $recup3; $type_n = 1 unless $type_n ; foreach my $r ($recup1,$recup2,$recup3) { my $recup = "$r" if $r; $recup = lc $recup; $r = "xmltvid_$recup"; } my $type_numero = "$type_n"if $type_n; $type_numero =lc $type_numero ; $type_numero = "numero_$type_numero"; # recuperer le contenu du tableau des chaines selectionnees %ma_selection = (); #acceder a la liste de chaines for my $nom_source (sort keys %bouquets) { my @list_bouquets = sort keys %{$bouquets{$nom_source}}; for my $nom_bouquet (@list_bouquets) { my @list_options = sort keys %{$bouquets{$nom_source}{$nom_bouquet}}; for my $nom_option (@list_options) { @list_chaines = grep {$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$_}{cocher}==1} sort keys %{$bouquets{$nom_source}{$nom_bouquet}{$nom_option}}; for my $nom_chaine (@list_chaines) { # importer les donnees des chaines choisies foreach my $j ( 'name', 'source', 'bouquet', 'option','numero', 'icone', 'sid', 'xmltvid'){ if (exists $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$j}){ $ma_selection{$nom_chaine,$nom_bouquet}{$j} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$j}; }else { $ma_selection{$nom_chaine,$nom_bouquet}{$j} = ""; } } # importer les xmltvid des chaines choisies if (!$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup1}eq "") { $ma_selection{$nom_chaine,$nom_bouquet}{xmltvid} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup1}; $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{recuperateur}= $recup1; # memoriser le recuperateur de programme $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{xmltvid}= $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup1}; }elsif (! $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup2}eq ""){ $ma_selection{$nom_chaine,$nom_bouquet}{xmltvid} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup2}; $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{recuperateur}= $recup2; # memoriser le recuperateur de programme $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{xmltvid}= $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup2}; }elsif (! $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup3}eq ""){ $ma_selection{$nom_chaine,$nom_bouquet}{xmltvid} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup3}; $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{recuperateur}= $recup3; # memoriser le recuperateur de programme $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{xmltvid}= $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup3}; }else{ # $ma_selection{$nom_chaine,$nom_bouquet}{xmltvid} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{xmltvid}; $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{recuperateur}= 'sans xmltvid'; # memoriser le recuperateur de programme } # importer les numeros des chaines choisies if (!$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$type_numero}eq "") { $ma_selection{$nom_chaine,$nom_bouquet}{numero} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$type_numero}; $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{numero}= $type_numero; # memoriser le plan de numerotation }else{ $ma_selection{$nom_chaine,$nom_bouquet}{numero} = ""; $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{numero}= ""; # memoriser le plan de numerotation } # n'est pas inclus dans mythtv $ma_selection{$nom_chaine,$nom_bouquet}{in_mythtv} = 0 ; } } } } liste_chaines(); Lister_source_selectionne ( ) ; } # identifier le type de colonne sub set_style_state { my ($w) = @_; my ($r, $c) = split(/,/, $w->{_b1_row_col}); if (grep(!$w->{columneditstyles}{$c} || $_ eq $w->{columneditstyles}{$c}, qw(optionmenu readonly button checkbutton))) { $w->selectionClear('all'); $w->configure(state => 'disabled'); } else { $w->configure(state => 'normal'); $w->activate($w->{_b1_row_col}); } } sub end_edit { my ($w) = @_; $w->configure(-state => 'disabled'); $w->selectionClear('all'); } # remplir le tableau des chaines a partir du fichier de configuration sub liste_chaines { # definir la configuration du tableau my $tm = $liste_chaine->Subwidget('scrolled'); # definition du mode de fonctionnement des colonnes $tm->{columneditstyles} = {qw(1 readonly 2 readonly 3 readonly 4 editable 5 editable 6 editable 7 editable )}; # definition des noms de colonnes $tm->{titre_colonne} = {qw(1 nom 2 fournisseur 3 option 4 numero 5 xmlid 6 logo 7 sid )}; # definir la largueur des colonnes $liste_chaine->colWidth( 1=>25, 2=>15, 3=>15, 4=>8, 5=>20, 6=>40, 7=>8); # definition des differents etats des cases du tableau # $liste_chaine->tagConfigure('OFF', -bg => 'gray60', -relief => 'raised'); # $liste_chaine->tagConfigure('ON', -bg => 'gray80', -relief => 'sunken'); $liste_chaine->tagConfigure('sel', -bg => 'gray70', -relief => 'flat'); $liste_chaine->tagConfigure('readonly', -bg => 'gray90',-relief => 'groove'); # $liste_chaine->tagConfigure('visible', -bg => 'yellow',-relief => 'groove' ); $liste_chaine->tagConfigure('in_mythtv', -bg => 'green',-relief => 'groove' ); $liste_chaine->tagConfigure('modified', -bg => 'red',-relief => 'groove' ); $liste_chaine->bind('' => \&end_edit); # clean up if mouse leaves the widget $liste_chaine->bind('',sub { my $w = shift; $w->selectionClear('all'); $w->configure(-state => 'disabled'); }); # highlight the cell under the mouse $liste_chaine->bind('', sub { my $w = shift; my $Ev = $w->XEvent; if( $w->selectionIncludes('@' . $Ev->x.",".$Ev->y)){ Tk->break; } $w->selectionClear('all'); $w->selectionSet('@' . $Ev->x.",".$Ev->y); Tk->break; ## "break" prevents the call to TableMatrixCheckBorder }); # le bouton droit de la souris edit la case $liste_chaine->bind('Tk::TableMatrix' => '', sub { my ($w) = @_; my $Ev = $w->XEvent; my ($x, $y) = ($Ev->x, $Ev->y); my $rc = $w->index("\@$x,$y"); my $var = $w->cget(-var); my ($r, $c) = split(/,/, $rc); $r && $c || return; $w->{_b1_row_col} = "$r,$c"; set_style_state($w); my $style= $w->{columneditstyles}{$c} || 'editable'; $liste_chaine->tagCell('active', $rc) if $style eq 'editable'; } ); $liste_chaine->bind('Tk::TableMatrix' =>'' => sub { my ($window) = @_; my $Ev = $window->XEvent; my ($x, $y) = ($Ev->x, $Ev->y); my $rc = $window->index("\@$x,$y"); my $current_index = $rc; $liste_chaine->MoveCell(2,0); $window->selectionClear('all'); $window->configure(-state => 'disabled'); } ); # replace std b1-release # $liste_chaine->bind('Tk::TableMatrix' => '', \&set_style_state); # supprimer toutes les ligne du tableau # Calcul du nombre de ligne dans le tableau my $number_rows = $liste_chaine->cget( -rows ); #supprimer les lignes du tableau $liste_chaine->deleteRows ('0',"$number_rows"); # inititialize the array, titles, and celltags #acceder a la liste de chaines my@data= sort keys %ma_selection; my @dat =(1, @data); for my $r ( 0 .. $#data+1) { my $ch = $dat[$r]; # Calcul du nombre de ligne dans le tableau my $number_rows = $liste_chaine->cget( -rows ); # Insertion d'une ligne si nécessaire $liste_chaine->insertRows( 'end', 1 ) if ( $number_rows < $r + 1 ); # insertion des donnees dans chaque colonne my ($rc); for (my $c = 0; $c < $cols; $c++) { $rc = "$r,$c"; if (!$r || !$c) { $_data->{$rc} = $r || $tm->{titre_colonne}{$c} || ""; } else { %ColValue = ( 0=> "", 1 => $ma_selection{$ch}{name}, 2 => $ma_selection{$ch}{bouquet}, 3 => $ma_selection{$ch}{option}, 4 => $ma_selection{$ch}{numero}, 5 => $ma_selection{$ch}{xmltvid}, 6 => $ma_selection{$ch}{icone}, 7 => $ma_selection{$ch}{sid}, )if $ch; $_data->{"$r,$c"} = "$ColValue{$c}"if $ch ; $base_initial->{"$r,$c"} = "$ColValue{$c}"if $ch ; my $style = $tm->{columneditstyles}{$c} || 'editable'; if ($style eq 'readonly') { $liste_chaine->tagCell('readonly', $rc); } if ($ma_selection{$ch}{in_mythtv} eq 1) { $liste_chaine->tagCell('in_mythtv', $rc); } } } } Compter_occurence (); Lister_source_selectionne ( ) ; return ; } sub brscmd (){ # Solution 2 by Djibril # See http://www.developpez.net/forums/d1074157/autres-langages/perl/interfaces-graphiques/tablematrix-monitorer-modification/#post5953572 my ( $previous_index, $current_index ) = @_; # Valeur de la case selectionnée my $value_current_cell = $liste_chaine->get($current_index); # A chaque fois que l'utilisateur sélectionne une cellule, on stocke la valeur originale si ce n'était pas fait if ( not exists $base_initial->{$current_index} ) { $base_initial->{$current_index} = $value_current_cell; } # Si une case avait déjà était sélectionnée if ($previous_index) { # Valeur de la case précedemment selectionnee my $value_previous_cell = $liste_chaine->get($previous_index); # Affectons un tag à la cellule si cette dernière est différente de l'originale if ( $value_previous_cell ne $base_initial->{$previous_index} ) { $liste_chaine->tagCell( 'modified', $previous_index ); } else { $liste_chaine->tagCell( 'default', $previous_index ); } } #remettre les statistiques a jour Compter_occurence () ; } #--------------------------------------------------------- # routine de l'onglet configuration #--------------------------------------------------------- sub Lister_source_selectionne (){ my %bouquet_selec; %liste_source_selectionne = (); my @list; for (my $i = 1; $i <= $stat{chaine_sel}; $i++){ my $index = "$i,2"; push (@list, $liste_chaine -> get($index)); } @liste_source_selectionne = Supression_doublons (@list); } sub Supression_doublons { my (@ref_tabeau) = @_; my %hash_sans_doublon; # Comme un hash ne peut pas avoir deux clés identiques, # utilser ces clé permet d'avoir un tableau unique @hash_sans_doublon{ @ref_tabeau } = (); # Pas besoin de surcharger le hash avec des valeurs inutiles # et ensuite, on renvoie le tableau des clés uniques return keys %hash_sans_doublon; } #--------------------------------------------------------- # routine de l'onglet statistique #--------------------------------------------------------- # compter le nombre d'occurence sub Compter_occurence () { ($stat{chaine_sel},$stat{xmltvid},$stat{numero},$stat{icone})=(0,0,0,0); # Calcul du nombre de ligne dans le tableau my $nbre_chaines_select = $liste_chaine->cget( -rows )-1; $stat{chaine_sel} = $nbre_chaines_select ; # Calcul du nombre d'occurence pour les xmltvid, numeros et icones dans le tableau for (my $i = 1; $i <= $stat {chaine_sel}; $i++){ my $index_xmltvid = "$i,5"; $stat{xmltvid} ++ if $liste_chaine->get($index_xmltvid); my $index_numero = "$i,4"; $stat {numero} ++ if $liste_chaine->get($index_numero); my $index_icone = "$i,6"; $stat{icone} ++ if $liste_chaine->get($index_icone); # $stat{kazer}++ if } } #--------------------------------------------------------- # routine du menu #--------------------------------------------------------- # sauvegarder les donnees dans un fichier sub sauvegarder { my $text ="ATTENTION !\n\nLe fichier $my_chaine_file existe déjà\n\nVoulez-vous remplacer ce fichier ?\n\nATTENTION !"; ask_boolean ($text, sub {store ( \%ma_selection, "$my_chaine_file")|| die "can't store to $my_chaine_file\n"}); store \%bouquets, "$ma_selection"; } #--------------------------------------------------------- # routine generale #--------------------------------------------------------- sub message{ my $m =shift; my $texte="veuillez patienter ..." if ($m eq'1'); $texte="Vous n'avez pas defini de recuperateur de programme" if ($m eq'2'); # $texte="Vous n'avez pas recuperateur le donnees de votre selection" if ($m eq'3'); $fenetre_message= MainWindow->new( ); # Création d'une nouvelle fenêtre -- veuillez patienter my $label_accueil = $fenetre_message->Label( # Affichage d'un texte -text => $texte, -background => 'red', )->pack(); $fenetre_message->overrideredirect(1); # Pour enlever les décors # centrer dans la fenetre # Height and width of the screen my $largeur_ecran = $fenetre_message->screenwidth(); my $hauteur_ecran = $fenetre_message->screenheight(); # update le widget pour récupérer les vraies dimensions $fenetre_message->update; my $largeur_widget = $fenetre_message->width; my $hauteur_widget = $fenetre_message->height; # On centre le widget en fonction de la taille de l'écran my $nouvelle_largeur = int( ( $largeur_ecran - $largeur_widget ) / 2 ); my $nouvelle_hauteur = int( ( $hauteur_ecran - $hauteur_widget ) / 2 ); $fenetre_message->geometry($largeur_widget . "x" . $hauteur_widget . "+$nouvelle_largeur+$nouvelle_hauteur"); $fenetre_message->update; if ($m eq"2"or $m eq"3"){ sleep 1; $fenetre_message->destroy; } } # nettoyage des noms de chaines pour comparaison entre les diffrentes sources sub CleanNom{ my $E=shift; $E = NFKD $E; #supprime les accents $E =~ s/\pM//g; #supprime les accents $E =uc $E ; # met en majuscule $E =~ s/13EME/13E/; # renommer certains termes $E =~ s/EXTREM /EXTREME/; $E =~ s/ENCYCLOPEDIA/ENCYCLO/; $E =~ s/NAT GEO WILD/NATIONALGEOGRAPHICWILD/; $E =~ s/DE LA LOIRE/DE LOIRE/; $E =~ s/LA CHAINE PARLEMENTAIRE/LCP/; $E =~ s/SCIFI/SYFY UNIVERSAL/; my @i = ( ' FRANCE', ' EUROPE', ' SAT', 'FRANCAIS', 'UK', 'AMERICA', ' INTERNATIONAL', '\(' , '\)', '\.', '\>', '\-', 'ENTERTAINMENT', 'LA CHAINE INFO', 'CHANNEL', 'OLYMPIQUE', 'LYONNAIS', 'FBS', 'ROUSSILLON'); for my $i (@i) { $E =~ s/$i//; # supprimer les termes definis dans @i } $E =~ s/\s+//g; # supprime les espaces $E =~ s/.*RADIO.*//; # suppression des radios return ( $E) } #---------------------------------------------------------------------------------------------------------------------------- # nettoyage des noms de chaines pour comparaison entre les diffrentes sources sub CleanNom1{ my $E=shift; my @i = ( ' France', " Fran.ais", ' Sat'); for my $i (@i) { $E =~ s/$i//; # supprimer les termes definis dans @i } return ($E) } #----------------------------------------------------------------------------------------------------------------------------- # Give some information to the user # Parameters: # current module # text to show to the user sub say($) { my $question = shift; my$main_window1 = MainWindow->new; $main_window1->focus; $main_window1->title("Information"); $main_window1->minsize(qw(400 250)); $main_window1->geometry('+250+150'); my $top_frame = $main_window1->Frame()->pack; my $middle_frame = $main_window1->Frame()->pack; my $bottom_frame = $main_window1->Frame()->pack(-side => 'bottom'); $top_frame->Label(-height => 2)->pack; $top_frame->Label(-text => $question)->pack; $bottom_frame->Button(-text => "OK", -command => sub { $main_window1->destroy; }, -width => 10, )->pack(-padx => 2, -pady => 4); MainLoop(); } #------------------------------------------------------------------------------------------------------------------------------------- # Ask a yes/no question. # sub ask_boolean($$$) { my ($text,$command, $option ) =@_; my$main_window1 = MainWindow->new; $main_window1->title('Question'); $main_window1->minsize(qw(400 250)); $main_window1->geometry('+250+150'); my$top_frame = $main_window1->Frame()->pack; my $bottom_frame = $main_window1->Frame()->pack(-side => 'bottom'); $top_frame->Label(-height => 2)->pack; $top_frame->Label(-text => $text)->pack; $bottom_frame->Button(-text => "Yes", -command => sub { $main_window1->destroy; &$command($option) ;}, -width => 10, )->pack(-side => 'left', -padx => 2, -pady => 4); $bottom_frame->Button(-text => "No", -command => sub { $main_window1->destroy;}, -width => 10 )->pack(-side => 'left', -padx => 2, -pady => 4); MainLoop(); } #========================================================================= #= INTRODUCTION DES DONNEES DANS LA BASE DE DONNEES DE MYTHTV : MYTHCONVERG #========================================================================= my $host = 'localhost'; my $database = 'mythconverg'; my $user = 'mythtv'; my $pass = $user; sub ReadDatabase () { use DBI; use DBD::mysql; # paramétrage des variables locales my $donnee_complementaire = shift; my $db = undef; my $connect = undef; my ($numero_mythtv, $xmltvid_mythtv, $icon_mythtv); FindDatabase(); # find the database # BackupDatabase(); # Sauvegarde base de données $connect = OpenDatabase(); # ouvrir la base de données # lire des donnees de la base de donnees Recherche_source_mythtv ; my @liste_source_mythtv = shift; foreach my $Source_mythtv (@source_mythtv) { my $query = "select channel.name from channel , dtv_multiplex , videosource where channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Source_mythtv.'"'." and (channel.name != NULL or channel.name NOT like ".'""'.");"; my $query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; while (my @channame = $query_handle->fetchrow()){ foreach my $chaine_mythtv (@channame) { # pour chaque chaine de la base de données my $chaine_mythtv_clean = CleanNom ( $chaine_mythtv); # recuperer les numeros de chaines my $query1 = "select channel.channum from channel , dtv_multiplex , videosource where channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Source_mythtv.'"'." and channel.name = ".'"'.$chaine_mythtv.'"'.";"; my $query_handle1 = $connect->prepare($query1); $query_handle1->execute() || die "Unable to query channel table"; $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{type_numero} = $query_handle1->fetchrow(); $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{source} = $Source_mythtv; $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{bouquet} = $Source_mythtv; $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{option} = 'bouquet mythtv'; $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{'name'} = $chaine_mythtv_clean; $query_handle1->finish; # recuperer les xmltvid $query1 = "select channel.xmltvid from channel , dtv_multiplex , videosource where channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Source_mythtv.'"'." and channel.name = ".'"'.$chaine_mythtv.'"'.";"; $query_handle1 = $connect->prepare($query1); $query_handle1->execute() || die "Unable to query channel table"; $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{xmltvid} =(); $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{xmltvid} = $query_handle1->fetchrow(); $query_handle1->finish; # recuperer les icones $query1 = "select channel.icon from channel , dtv_multiplex , videosource where channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Source_mythtv.'"'." and channel.name = ".'"'.$chaine_mythtv.'"'.";"; $query_handle1 = $connect->prepare($query1); $query_handle1->execute() || die "Unable to query channel table"; $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{icone} = $query_handle1->fetchrow(); $query_handle1->finish; # recuperer "visible" $query1 = "select channel.visible from channel , dtv_multiplex , videosource where channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Source_mythtv.'"'." and channel.name = ".'"'.$chaine_mythtv.'"'.";"; $query_handle1 = $connect->prepare($query1); $query_handle1->execute() || die "Unable to query channel table"; $donnee_mythtv {$Source_mythtv}{$Source_mythtv}{'bouquet mythtv'}{$chaine_mythtv_clean}{cocher} = $query_handle1->fetchrow(); $query_handle1->finish; } } $query_handle->finish; } store \%donnee_mythtv, "$file_donnee_mythtv"; } sub WriteDatabase () { ReadDatabase; # %compteur_bd_mythtv = ( ); # demander confirmation pour chaque source de mythtv foreach my $s_mythtv (@source_mythtv) { my $question =ask_boolean("Voulez-vous introduire les données pour la source \"$s_mythtv\" ?", \&modifier_database, $s_mythtv ); } } sub modifier_database() { my $Myth_VideoSource=shift; my $sup_invisible=0; #permet de supprimer les chaines qui sont marquées comme invisible dans la base (par défaut à 1= suppression; 0 pour conserver les chaines) my $source_selection; my ( %chan_map, %channum_map, %xmltvid_map, %icon_map, %sid_map, %dbvisible ,%visible_map) ; my ( %dbchanname, %db_xmltvid, %dbchannum, %dbcallsign, %dbsid , %dbicon) ; my $connect = undef; my $item; message (1); # rechercher les bouquets associes la source video de mythtv foreach $source_selection(sort keys %source_bouquet) { my $sc =$source_bouquet{$source_selection}; if ($sc eq $Myth_VideoSource) { $connect = OpenDatabase(); # ouvrir la base de données # recuperer la liste des chaines de la base de donnees my $query = "select channel.name from channel , dtv_multiplex , videosource where channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Myth_VideoSource.'"'." and (channel.name != NULL or channel.name NOT like ".'""'.");"; my $query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; while (my @channame = $query_handle->fetchrow()) { foreach my $chaine (@channame) { # pour chaque chaine de la base de données # nettoyer les nom de la chaine my $idc =$chaine ; $idc =~ s/Fr3/France 3/; $idc =~ s/ \?/ Ô/; $idc =~ s/Rhone/Rhone-Alpes/; my $id1 = CleanNom ( $idc ) ; if ($ma_selection{$id1,$source_selection}){ # marquer les chaines comme existante dans mythtv $ma_selection{$id1,$source_selection}{in_mythtv}=1 ; $dbvisible{$chaine} = "0"; # rendre toutes les chaines invisibles my $channame = $ma_selection{$id1,$source_selection}{name} ; $channame=~ s/\s+$//; $channame=~ s/^\s+//; my $channum=$ma_selection{$id1,$source_selection}{numero} ; # copier et nettoyer les champs du fichier de conf $channum=~ s/\s+$//; $channum=~ s/^\s+//; my $visible= 1 ; my$callsign=$ma_selection{$id1,$source_selection}{name} ; $callsign=~ s/\s+$//; $callsign=~ s/^\s+//; $callsign= ucfirst $callsign; # mettre en majuscule, ucfirst = premier lettre en majuscule, lc tout en minuscule my $xmltvid=$ma_selection{$id1,$source_selection}{xmltvid}; $xmltvid=~ s/\s+$//; $xmltvid=~ s/^\s+//; my $sid=$ma_selection{$id1,$source_selection}{sid}; $sid=~ s/\s+$//; $sid=~ s/^\s+//; if (($channum ne "none" && $visible eq "1")) { # introduire les données dans une base de données provisoire $dbchanname{$chaine} = $channame; $dbchannum{$chaine} = $channum; $dbvisible{$chaine} = $visible; $dbcallsign{$chaine} = $callsign; $db_xmltvid{$chaine} = $xmltvid; $dbsid{$chaine} = $sid; } # telecharger les icones if ($ma_selection{$id1,$source_selection}{icone}) { my $iconloc=$ma_selection{$id1,$source_selection}{icone}; $iconloc =~ s/\s+$//; $iconloc =~ s/^\s+//; # my $visible=$visible_map{$id1}; # $visible=~ s/\s+$//; # $visible=~ s/^\s+//; if (($iconloc ne "none" && $visible eq "1")) { my @name = split('/', $iconloc); # télécharger les icones, si n'existe pas my $num=@name; my $filename=$name[$num-1]; if ( ! -e "$location/$filename"){ my $command = "wget -q $iconloc -O $location/$filename"; print "grabbing $iconloc .."; system ($command); print ".. done \n"; } $dbicon{$chaine} = $location."/".$filename; } } } } } $query_handle->finish; } } # introduire les donnees dans la base de donnee pour la source concernee if ($WriteXmltvid ne 0) { foreach $item (keys %db_xmltvid) { $compteur_bd_mythtv{xmltvid}++; my $a =$compteur_bd_mythtv{xmltvid}; print "setting channel $item to have xmltvid $db_xmltvid{$item}\t\t $a \n"; my $query = "UPDATE channel,dtv_multiplex,videosource SET channel.xmltvid = ".'"'.$db_xmltvid{$item}.'"'." WHERE channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Myth_VideoSource.'"'." and channel.name = ".'"'.$item.'"'.";"; my$query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; } } if ($WriteIcone ne 0) { foreach $item (keys %dbicon) { $compteur_bd_mythtv{icone}++; print "setting channel $item to have icon from $dbicon{$item} \n"; my$query = "UPDATE channel,dtv_multiplex,videosource SET channel.icon = ".'"'.$dbicon{$item}.'"'." WHERE channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Myth_VideoSource.'"'." and channel.name = ".'"'.$item.'"'.";"; my$query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; } } if ($WriteXmltvid ne 0 && $WriteIcone ne 0 ) { foreach $item (keys %dbvisible) { # print "setting channel $item to have visible from $dbvisible{$item} \n"; my $query = "UPDATE channel,dtv_multiplex,videosource SET channel.visible = ".'"'.$dbvisible{$item}.'"'." WHERE channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Myth_VideoSource.'"'." and channel.name = ".'"'.$item.'"'.";"; my $query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; } foreach $item (keys %dbchannum) { $compteur_bd_mythtv{numero} ++; print "setting channel $item to have number from $dbchannum{$item} \n"; my $query = "UPDATE channel,dtv_multiplex,videosource SET channel.channum = ".'"'.$dbchannum{$item}.'"'." WHERE channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Myth_VideoSource.'"'." and channel.name = ".'"'.$item.'"'.";"; my $query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; } foreach $item (keys %dbcallsign) { $compteur_bd_mythtv{callsign} ++; print "setting channel $item to have callsign from $dbcallsign{$item} \n"; my$query = "UPDATE channel,dtv_multiplex,videosource SET channel.callsign = ".'"'.$dbcallsign{$item}.'"'." WHERE channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Myth_VideoSource.'"'." and channel.name = ".'"'.$item.'"'.";"; my$query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; } foreach $item (keys %dbchanname) { # print "setting channel $item to have name from $dbcallsign{$item} \n"; # introduire les noms de chaines en majuscules my$query = "UPDATE channel,dtv_multiplex,videosource SET channel.name = ".'"'.$dbchanname{$item}.'"'." WHERE channel.mplexid = dtv_multiplex.mplexid and dtv_multiplex.sourceid = videosource.sourceid and videosource.name = ".'"'.$Myth_VideoSource.'"'." and channel.name = ".'"'.$item.'"'.";"; my $query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; } # supprimer les chaines invisibles si la variable sup_visible =1 if ($sup_invisible eq 1){ $compteur_bd_mythtv{sup_invisible} ++; my$query = "DELETE FROM channel WHERE visible = 0"; # suppression des chaines invisibles my$query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; # print "supression des chaines invisibles \n"; } # supprimer les chaines sans nom $compteur_bd_mythtv{sup_ss_nom} ++; my $query = "DELETE FROM channel WHERE name = ''" ; # suppression des chaines sans nom my $query_handle = $connect->prepare($query); $query_handle->execute() || die "Unable to query channel table"; # print "supression des chaines sans nom \n"; } say ( "La mise a jour de votre base de donnees est terminee avec succes. MERCI D'AVOIR UTILISER CE SCRIPT. N'oubliez pas d'installer votre récupérateur de programme et de lancer mythfilldatabase.\n"); liste_chaines () ; #$liste_chaine -> update; $fenetre_message->destroy; } # SAUVEGARDE DE LA BASE DE DONNÉES sub BackupDatabase() { # configurer la sauvegarde si pas fait if ( ! -e "$ENV{HOME}/.mythtv/backuprc" ) { open(FILE, ">$ENV{HOME}/.mythtv/backuprc") or die("Unable to open file"); # configurer la sauvegarde si pas fait print FILE "DBBackupDirectory=$ENV{HOME}/.mythtv\n"; close(FILE); } # sauvegarder avec /usr/share/mythtv/mythconverg_backup ou avec /usr/local/share/mythtv/mythconverg_backup if ( -e '/usr/share/mythtv/mythconverg_backup.pl') { system "/usr/share/mythtv/mythconverg_backup.pl"; # sauvegarder print "base de données sauvegardée sous $ENV{HOME}/.mythtv\n"; } elsif ( -e '/usr/local/share/mythtv/mythconverg_backup.pl') { system "/usr/local/share/mythtv/mythconverg_backup.pl" ; print "base de données sauvegardée sous $ENV{HOME}/.mythtv\n"; } else { die "Impossible de sauvegarder la base de données, le script mythconverg_backup n'a pas été trouvé ?\n\n" } # quitter } # Try to find the database // essaye de trouver la base de données sub FindDatabase() { my $found = 0; my @mysql = ('/usr/local/share/mythtv/mysql.txt', '/usr/share/mythtv/mysql.txt', '/etc/mythtv/mysql.txt', '/usr/local/etc/mythtv/mysql.txt', "$ENV{HOME}/.mythtv/mysql.txt", 'mysql.txt' ); foreach my $file (@mysql) { next unless (-e $file); $found = 1; open(CONF, $file) or die "Unable to open $file: $!\n\n"; while (my $line = ) { # Cleanup next if ($line =~ /^\s*#/); $line =~ s/^str //; chomp($line); # Split off the var=val pairs my ($var, $val) = split(/\=/, $line, 2); next unless ($var && $var =~ /\w/); if ($var eq 'DBHostName') { $host = $val; } elsif ($var eq 'DBUserName') { $user = $val; } elsif ($var eq 'DBName') { $database = $val; } elsif ($var eq 'DBPassword') { $pass = $val; } } close CONF; } if ( ! $found ) { die "Unable to locate mysql.txt: $!\n\n" } } # openDatabase() - Connect or die // subroutine de connexion à la base de données sub OpenDatabase() { my $db = DBI->connect("dbi:mysql:database=$database" . ":host=$host", $user, $pass) or die "Cannot connect to database: $!\n\n"; return $db; } #recherche les sources definies dans mythtv sub Recherche_source_mythtv () { FindDatabase(); # find the database my $connect = OpenDatabase(); # ouvrir la base de données my $query1 = "SELECT name FROM videosource where name != NULL or name NOT like ".'""'.";"; #interroge la base pour connaitre le nom des sources my $query_handle1 = $connect->prepare($query1); $query_handle1->execute() || die "Unable to query videosource table"; @source_mythtv =(); while ( my $VideoSource = $query_handle1->fetchrow()) { push(@source_mythtv, "$VideoSource"); } return @source_mythtv; }