#!/usr/bin/perl

=head1 NAME

"configuration_chaine" est une application graphique qui permet de choisir les chaînes souhaitées 
                                     et d'introduire les données de ces chaînes dans la base de données de MythTV.

=head1 SYNOPSIS

 To use: 
   ./configuration_chaine.pl

=head1 DESCRIPTION

Ce script permet de choisir les chaînes désirées et d'introduire les données suivantes dans la base de données de mythtv
        un numéro de chaîne, 
	un nom de chaîne, 
	un identifiant d'appel (callsign)
	un identifiant xmltvid, 
	une adresse de téléchargement de l'icone,
        le numéro sid pour les chaînes du satellite

Il est compatible avec les différents modes de réception de télévision disponible en France ou en Europe
(Hertzien, Cable/satellite, Canal+ Sat, ...) et avec les différents récupérateurs de programmes disponible en France.
Ce script parcourt le net pour fournit les informations les plus à  jour possible.
Parmi les sites utilisés, se trouve lyngsat.com, telerama.fr, telepoche.fr.......
Il stocke les informations sous forme de fichier qui est par defaut enregistré sous ~/.mythtv/config_chaine.
Si les informations ne sont pas disponibles sur le net, elles sont mises à  diposition sur le serveur de mytharch sous forme de fichier.

Il permet egalement d'introduire ces données dans la base données de Mythtv "mythconverg" après avoir effectuer une sauvegarde de celle-ci.


=head1 AUTHOR
Gilles  C
gillessoixantequatorze@orange.fr

Rapporter les bugs sur <http://mythtv-fr.org/bugtracker/index.php?project=5>

=cut



#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;
use Storable qw(nstore retrieve); 
use DBI;
use DBD::mysql;
use Tk::Dialog;
use LWP;
use LWP::Simple;
use Tk::Pane;
use configuration;          # fichier fourni avec ce script
#use constant {
#	true => 0,
#	false =>0,
#};
#use Data::Dump qw(pp); # require installation
#use Data::Dumper;         # require installation





my $version = '0.2';

# definir les variables globales et les  options par defaut
	my $fichier_config = 'Utiliser le fichier de configuration existant' ;
	my $action = 'Créer une nouvelle sélection';
	my $type_num = "Aucun";
	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 $fenetre_onglets;
	my %liste_source_selectionne;
	my %test;
	my %association_source;
	my %donnee_mythtv;
	my @liste_source;
	my %compteur_bd_mythtv;
	my $WriteXmltvid;
	my $WriteIcone;
	my $WriteNum;
	my $base_initial;
	my $zone_config_mythtv ;
	my $cle_tri ='name';
	my $count = 0 ;
	my $progress ;
	my %fenetre_recuperateur = ( );
	my $zone_recuperateur;
	my $modif = 0;
	my $tm;
	my $label_accueil ;
	my $label;
	my $zone_numero;
	my $liste_chaine;
	my $onglet_configuration;
	my $onglet_statistique;
	my $onglet_selection;
	my $blocnote ;
	my $modif_donnee = 0;
	my $lab_nbr_chaine;
	my $label_chaine;
	my $bouquetstree;
	my $cols;
	my $rows ;
	my $_data = {};
	my $type_num_sauv ;
	my @recuperateur_sauv = (0) ;
	my %bouquets_sauv;
	my %ma_selection_sauv;
	my $debug = 0;
	
#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"; 
#	my $conf_dir = "$home/provisoire/configuration_chaine" if $debug eq 1;
	(-d $conf_dir) or mkdir($conf_dir, 0777)
	or die "cannot mkdir $conf_dir: $!";
	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/config_chaine";
	
	# emplacement de sauvegarde des icones
	my $location = "$ENV{HOME}/.mythtv/channels" ;  
	(-d $location) or mkdir($location, 0777)
	or die "cannot mkdir $location: $!";
	
	&lister_chaines_de_configfile;


#=====================
# 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 );

#=====================	
#création des onglets
#=====================
		$fenetre_onglets = $fenetre_principale->Frame()->pack(qw/-fill both  -side left -expand 1 / );
		
		$blocnote = $fenetre_onglets->NoteBook(
			-backpagecolor         => 'white',
			-bg                            => 'green',
			-inactivebackground => 'white',
			)->pack(qw/-fill both -expand 1/);

	# creation des onglets 
		
		$onglet_configuration = $blocnote->add( "onglet_configuration", -label => "CONFIGURATION", );
		$onglet_selection = $blocnote->add( "onglet_selection", -label => "VOTRE SELECTION", );
		$onglet_statistique = $blocnote->add( "onglet_statistique", -label => "STATISTIQUES", );


#========================
# Menu de l'application
#========================
&menu_configuration;

MainLoop();    # Obligatoire


#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# debut des sous-routines
#----------------------------------------------------------

#----------------------------------------------------------
#subroutine -- votre selection
#----------------------------------------------------------

# creation de l'onglet selection
sub creation_onglet_selection{
			print "creation_onglet_selection\n" if $debug eq 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 $color = 'white';
	
	$bouquetstree = $zone_arbre->Scrolled(
		'Tree',
		-background         => $color,
		-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');

	

	#--------------------------------------------------------------------------
	# Remplissage du tableau ( tablematrix)
	#--------------------------------------------------------------------------	
	
	 ($rows,$cols) = (1,18); # 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
		$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',
			 -browsecommand => \&brscmd,
			)->pack(qw/-expand 1 -fill both/);

}


# Remplissage de l'arborescence
sub Remplir_arbre {
				print "remplir arbre\n" if $debug eq 1;
		&message(1);
		@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;
#							$color = 'green' if $bouquets{$source}{$bouquet}{$option}{$chaine}{in_mythtv}eq 1;

						# memoriser la source, et l'option de chaque couple source/chaine
							$ck_bt->{$bouquet, $chaine}->{source}= $source;
							$ck_bt->{$bouquet, $chaine}->{option}= $option;
						}
					}						
				}	
			}
			
		# 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();


	
		foreach my $node (@liste_node) {
			# incrementer la fenetre de progression
				$count++;
				$progress -> value ($count);
				$fenetre_message-> update;
			#fermer tous les nodes	
				$bouquetstree->close($node);
			# marquer les enfants et les parents si le node est actif	   
				if ( ! $bouquetstree->info('children', $node)) {
					if ($ck_bt->{$node}->{checked}eq 1  ){
						&map_select_to_check( $node)  ;
					}
				}
		}
	$fenetre_message-> destroy ;
}



# mappage des boutons selectionnes
sub map_check_to_select {
	&map_select_to_check;
	&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 {
	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 la liste de chaine dans le tableau des chaines de l'onglet bouquet
sub afficher_list_chaine {
					print "afficher_list_chaine\n" if $debug eq 1;

	# 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) if $modif eq 0;

	return ;
}


# Supprimer les donnees de tablematrix
sub supprimer_donnees_tableau (){
				print "supprimer_donnees_tableau\n" if $debug eq 1;
	# 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");

}

# supprimer les donnees du tableau et de la liste
sub supprimer_tout(){
				print "supprimer_tout\n" if $debug eq 1;
	%ma_selection= ();
	&supprimer_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');
	}
}


# afficher les donnees des chaines selectionnees
sub afficher_ma_selection ($$$$){
				print "afficher_ma_selection\n" if $debug eq 1;
	#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 = ();
#		%ma_selection = %ma_selection_sauv if $recuperateur_sauv[0] eq 1 ;
		#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}eq 1}
										sort keys %{$bouquets{$nom_source}{$nom_bouquet}{$nom_option}};
							for my $nom_chaine (@list_chaines) {
								my $nom_chaine_clean = CleanNom($nom_chaine);
	
								# importer les donnees des chaines choisies
									foreach my  $j ( 'name', 'source', 'bouquet', 'option','numero_tnt', 'numero_tnt_hd','numero_canalsat', 'numero_canalsat_hd', 'numero_canalsat_new', 
													'numero_canalsat_hd_new','icone', 'sid', 'xmltvid_kazer','xmltvid_mc2xml', 'xmltvid_telepoche',
													'xmltvid_telerama','xmltvid_iphone', 'in_mythtv','modified_in_mythtv','cocher'){
										$ma_selection{$nom_chaine_clean,$nom_bouquet}{$j} = "";
										if (exists $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$j}){
											$ma_selection{$nom_chaine_clean,$nom_bouquet}{$j} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$j};
										}
									}
									
								# importer les xmltvid des chaines choisies
									if (!$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$recup1}eq "") {
										$ma_selection{$nom_chaine_clean,$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_clean,$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_clean,$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 ""
											||  !$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$type_numero}eq 'sans') {
										$ma_selection{$nom_chaine_clean,$nom_bouquet}{numero} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{$type_numero};
										$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{type_numero}= $type_numero;          # memoriser le plan de numerotation
									}else{
										$ma_selection{$nom_chaine_clean,$nom_bouquet}{numero} = "";
										$ma_selection{$nom_chaine_clean,$nom_bouquet}{numero} = $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{numero}
										    if $bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{numero};
#										$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{type_numero}= "";          # memoriser le plan de numerotation
									}
						}
					}						
			}	
		}
		
	&remplir_tableau();
#	&Lister_source_selectionne ( )  ;
}



	
# remplir le tableau des chaines a partir du fichier de configuration
sub remplir_tableau {
	&supprimer_donnees_tableau ;
				print "remplir_tableau\n" if $debug eq 1;	
#	# restaurer ma selection suite en modification de la base
#		%ma_selection =%ma_selection_sauv if $recuperateur_sauv[0] eq 1 ;

	#acceder a la liste de chaines
		my @data = sort { tri_colonne($a, $b)} 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_row = $liste_chaine->cget( -rows );

			# Insertion d'une ligne si nécessaire
				$liste_chaine->insertRows( 'end', 1 ) if ( $number_row < $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} || "";
							$liste_chaine->tagCell('titre_col', "0,$c");
						}
					else
						{
							if ($modif eq 0){
								%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}, 8 => $ma_selection{$ch}{source} )if $ch;
							}else{
								%ColValue = ( 0=> "",  
								1 => $ma_selection{$ch}{name}, 
								2 => $ma_selection{$ch}{source},
								3 => $ma_selection{$ch}{bouquet}, 4 => $ma_selection{$ch}{option}, 
								5 => $ma_selection{$ch}{numero_tnt}, 6 => $ma_selection{$ch}{numero_tnt_hd},
								7 => $ma_selection{$ch}{numero_canalsat}, 8 => $ma_selection{$ch}{numero_canalsat_hd},
								9 => $ma_selection{$ch}{numero_canalsat_new}, 10 => $ma_selection{$ch}{numero_canalsat_hd_new},
								11 => $ma_selection{$ch}{xmltvid_kazer}, 12 => $ma_selection{$ch}{xmltvid_mc2xml}, 
								13 => $ma_selection{$ch}{xmltvid_telepoche}, 14 => $ma_selection{$ch}{xmltvid_telerama}, 
								15 => $ma_selection{$ch}{xmltvid_iphone}, 
								16 => $ma_selection{$ch}{icone},
								17 => $ma_selection{$ch}{sid} )if $ch;
							}										
							if ($ColValue{$c}){
								$_data->{"$r,$c"} = "$ColValue{$c}" ;
								$base_initial->{"$r,$c"} = "$ColValue{$c}";
							}else{
								$_data->{"$r,$c"} = ();
								$base_initial->{"$r,$c"} = ('wxzzwz');
							}						
							my $style = $tm->{columneditstyles}{$c} || 'editable';

							$liste_chaine->tagCell('readonly', $rc) if ($style eq 'readonly');
							$liste_chaine->tagCell('in_mythtv', $rc) if ($ma_selection{$ch}{in_mythtv} eq 1);
							$liste_chaine->tagCell('modified_in_mythtv', $rc) if ($ma_selection{$ch}{modified_in_mythtv} eq 1);
#$liste_chaine->tagCell( 'modified', $rc ) if $c eq 16 or $c eq 17;	
						}
				}
		}
		
		&Compter_occurence ();
#		&Lister_source_selectionne ( )  ; 
	return ;
}

# faire la difference entre les tris numeriques et alpha-numeriques
sub tri_colonne($$){
	my ($a,$b) = @_;
	
	if ($ma_selection{$a}->{"$cle_tri"} =~ /^\d/ 	and $ma_selection{$b}->{"$cle_tri"} =~ /^\d/ 
											and $cle_tri ne 'name' 
											and $cle_tri ne 'xmltvid'
											and $cle_tri ne 'xmltvid_kazer'
											and $cle_tri ne 'xmltvid_mc2xml'
											and $cle_tri ne 'xmltvid_telepoche'
											and $cle_tri ne 'xmltvid_telerama'
											and $cle_tri ne 'xmltvid_iphone'){

		$ma_selection{$a}->{"$cle_tri"}<=> $ma_selection{$b}->{"$cle_tri"};
	}
	else {
		$ma_selection{$a}->{"$cle_tri"}cmp $ma_selection{$b}->{"$cle_tri"};
	}
}



sub configurer_tableau() {
					print "configurer_tableau\n" if $debug eq 1;
		# definir la configuration du tableau
		my $tm = $liste_chaine->Subwidget('scrolled');

		if ($modif eq 0){
			# definition du mode de fonctionnement des colonnes
				$tm->{columneditstyles} = {qw(1 readonly
												2 readonly
												3 readonly
												4 readonly
												5 readonly
												6 readonly
												7 readonly
												8 readonly
									)};
			# definition des noms de colonnes								  
				$tm->{titre_colonne} = {qw(1 nom
												2 fournisseur
												3 option
												4 numero
												5 xmltvid
												6 logo
												7 sid
												8 source
											  )};
			# definir la largueur des colonnes
				$tm->colWidth( 1=>25, 2=>15, 3=>15, 4=>8, 5=>20, 6=>40, 7=>8, 8=>0, 9=>0, 10=>0, 11=>0, 12=>0, 13=>0,
								14=>0, 15=>0, 16=>0, 17=>0,);

		}else{
			# definition du mode de fonctionnement des colonnes
				$tm->{columneditstyles} = {qw(1 editable
												2 editable
												3 editable
												4 editable
												5 editable
												6 editable
												7 editable
												8 editable
												9 editable
												10 editable
												11 editable
												12 editable
												13 editable
												14 editable
												15 editable
												16 editable
												17 editable
											  )};
			# definition des noms de colonnes								  
				$tm->{titre_colonne} = {qw(1 nom
												2 source
												3 fournisseur
												4 option
												5 num_tnt
												6 num_tnt_hd
												7 num_canal
												8 num_canal_hd
												9 num_canal_new
												10 num_canal_hd_new
												11 xmltvid_kazer
												12 xmltvid_mc2xml
												13 xmltvid_telepoche
												14 xmltvid_telerama
												15 xmltvid_iphone
												16 logo
												17 sid
											  )};
	
			# definir la largueur des colonnes
				$tm->colWidth( 1=>25, 2=>15, 3=>15, 4=>15, 5=>8, 6=>8, 7=>8, 8=>8, 9=>8, 10=>8,
							         11=>20, 12=>20, 13 =>20, 14 => 20, 15=> 20, 16=> 40, 17=> 8);
		}
	
	# definition des differents etats des cases du tableau

		$liste_chaine->tagConfigure('sel', -bg => 'gray70', -relief => 'flat');
		$liste_chaine->tagConfigure('readonly', -bg => 'gray90',-relief => 'groove');
		$liste_chaine->tagConfigure('in_mythtv', -bg => 'DarkSeaGreen1',-relief => 'groove' ); #palegreen,mint cream
		$liste_chaine->tagConfigure('modified_in_mythtv', -bg => 'green',-relief => 'groove' );
		$liste_chaine->tagConfigure('modified', -bg => 'red',-relief => 'groove' );


	$liste_chaine->bind('<Key-Escape>' => \&end_edit);

	# clean up if mouse leaves the widget
	$liste_chaine->bind('<FocusOut>',sub
		{
			my $w = shift;
			$w->selectionClear('all');
			$w->configure(-state => 'normal');
		});

	# highlight the cell under the mouse
	$liste_chaine->bind('<Motion>', 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' => '<ButtonRelease-1>', 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' =>'<Key-Return>' =>
			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(1,0);
			$window->selectionClear('all');
			$window->configure(-state => 'normal');					
			}
		); 
	

	
	# replace std b1-release
		$liste_chaine->bind('Tk::TableMatrix' => '<ButtonRelease-3>', \sub
		{
			my ($w) = @_;
			my $Ev = $w->XEvent;
			my ($x, $y) = ($Ev->x, $Ev->y);
			my $rc = $w->index("\@$x,$y");
			my ($r, $c) = split(/,/, $rc);
			if ($modif eq 0){
				my @cles_tri = qw( name bouquet option numero  xmltvid icone sid) ;
				$cle_tri = $cles_tri[$c-1];
			}else{
				my @cles_tri = qw( name source bouquet option numero_tnt numero_tnt_hd numero_canalsat  numero_canalsat_hd numero_canalsat_new  numero_canalsat_hd_new
				 xmltvid_kazer xmltvid_mc2xml xmltvid_telepoche xmltvid_telerama xmltvid_iphone icone sid); 
				$cle_tri = $cles_tri[$c-1];
			
				# enlever les tags "modified"
					my @cellules_modifiees =$liste_chaine->tagCell('modified');
					foreach my $cel (@cellules_modifiees){
						$liste_chaine->tagCell( 'default', $cel);
						$modif_donnee = 0;
					}
			}
			&remplir_tableau;
		});
		
return ($tm);
}


# mettre  a jour le tableau (tablematrix)
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'original
					if ( $base_initial->{$previous_index} and $value_previous_cell ne $base_initial->{$previous_index} ) {
						$liste_chaine->tagCell( 'modified', $previous_index );					
					} else {
						$liste_chaine->tagCell( 'default', $previous_index );
					}
			}
				&Compter_occurence () ;
}


# 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 => 'normal');
		}
		else

		{
			$w->configure(state => 'normal');
			$w->activate($w->{_b1_row_col});
		}
	}

sub end_edit {
		my ($w) = @_;
		$w->configure(-state => 'normal');
		$w->selectionClear('all');
	}
	
#
#
#---------------------------------------------------------
# routine de l'onglet configuration
#---------------------------------------------------------

# creation de l'onglet configuration
sub creation_onglet_configuration(){
					print " creation_onglet_configuration\n" if $debug eq 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 générale\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 ('Créer une nouvelle sélection' ,'Modifier votre précèdente sélection','Utiliser les données 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 ('Créer un nouveau fichier de configuration' ,'Utiliser le fichier de configuration existant','Télécharger le dernier fichier de configuration' ) {
						$fenetre_config->Radiobutton(-text => "$_", 
						      -variable => \$fichier_config,
						      -value => "$_",
						       -command => \&change_conf
						     )->pack(-anchor => 'w');
					}
					$fenetre_config->place (-y=>270,-x => 20);
				
				#creation de la zone choix de numerotation				
					my $zone_numero= $zone_config->LabFrame(-labelside => 'acrosstop');
					$zone_numero= $zone_config->LabFrame(-label => "Quelle numérotation souhaitez-vous utiliser ?"); 
					
					foreach ('TNT', 'TNT_HD', 'CanalSat' ,'CanalSat_HD' ,'CanalSat_new' ,'CanalSat_HD_new' ,'Aucun' ) {
						$zone_numero->Radiobutton(-text => "$_", 
						      -variable => \$type_num,
						      -value => "$_",
						       -command => \&change_conf
						     )->pack(-anchor => 'w');
					}
					$zone_numero->place (-y=>420,-x => 20);

		# creation de la zone recuperateur
			&zone_recup;
		
		# creation de la zone de configuration de 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")-> pack(-side => 'top' );
}

# creation de la zone recuperateur
sub zone_recup() {
							print "zone_recup\n" if $debug eq 1;
		$zone_recuperateur = $onglet_configuration->Frame(-relief => 'groove', -borderwidth => 1)->place (  -x=>400, -height => 650, -width=> 400);
		$label= $zone_recuperateur -> Label (-text => "\nChoisissez les récupérateurs 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' );
			
			$fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-labelside => 'acrosstop');
			$fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-label => "Votre récupérateur de programmes  principal  " 
					) if ($i eq "1");
			$fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-label => "Votre second récupérateur de programmes     "  
					) if ($i eq "2");
			$fenetre_recuperateur{$i}= $zone_recuperateur->LabFrame(-label => "Votre troisième récupérateur 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
sub creation_zone_conf_mythtv ($){
						print "creation_zone_conf_mythtv\n" if $debug eq 1;
		my @liste_sour = Lister_source_selectionne ( ) ;
	# effacer et re-creer la zone de configuration de 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")-> pack(-side => 'top' );
					
		my $zone_text_mythtv = 	$zone_config_mythtv -> Text(-height => 3, -background => 'red',-font => '{Courrier New} 10 {bold}')->pack();
		$zone_text_mythtv -> insert('end',"Afin que les données soient correctement introduites dans Mythtv, vous devez définir les bouquets reçus 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 reçus par la source \"$s_mythtv\"",
					 -labelside => 'acrosstop',
					 )->pack( -anchor => 'w', -expand =>'1',-padx => 50);
			my %bt;
		# afficher les source de la selection
			foreach my $s_select( sort @liste_sour){
				$bt{$s_select}=$fenetre_source{$s_mythtv}->Checkbutton(-text => $s_select,
							# enregistrer les choix effectues
								-command => sub {$association_source{$s_select}= $s_mythtv;})
					 			->pack(-anchor => 'w');
				$bt{$s_select}->select() if ($association_source{$s_select}and  $association_source{$s_select}eq $s_mythtv);
			}
		}
}



# creation de la zone d'association des sources en cas de recuperation des chaines de mythconverg
sub config_mythtv() {
							print"config_mythtv\n" if $debug eq 1;
	# mettre a zero la zone de configuration  et creation zone conf mythtv 
		$type_num = 'Aucun';
		
		@recuperateur= (0,'Aucun', 'Aucun', 'Aucun');
		$zone_recuperateur -> destroy ;
		&zone_recup;

		$zone_config_mythtv->destroy ;
		$zone_config_mythtv = $onglet_configuration->Scrolled ( 'Pane',-scrollbars => "oe",
													-relief => 'groove',
													-background => 'ivory', 
													-borderwidth => 1)->place ( -x=>800, -height => 650, -width=> 450);
		my $bottom_frame = $zone_config_mythtv->Frame()->pack(-side => 'bottom');
		$label= $zone_config_mythtv -> Label (-text => "\nConfiguration en rapport avec MythTV",-background => 'ivory')-> pack(-side => 'top' );
		my $zone_text_mythtv = 	$zone_config_mythtv -> Text(-height => 3, 
												-background => 'red',
												-font   => '{Courrier New} 10 {bold}')->pack();
		$zone_text_mythtv -> insert('end',"Afin que les données soient correctement lues, vous devez\n associer chaque source de Mythtv");
		&Recherche_source_mythtv ();
		my %fenetre_source;
		%association_source =();

	#afficher une zone de choix pour chaque source de mythtv
		foreach my $s_mythtv (@source_mythtv) { 
			$fenetre_source{$s_mythtv}= $zone_config_mythtv->LabFrame(-label => "Bouquet(s) reçu(s) par la source \"$s_mythtv\"",
					 -labelside => 'acrosstop',
					 -background => 'ivory',
					 -foreground => 'brown',
					 )->pack( -anchor => 'w', -expand =>'1',-padx => 50);
		# afficher les mode de reception
			foreach my $sce(qw( tnt_fr   tntetrangere bisab3 canalsatcaraibes canalsatfr fransat orangeab3 orangeastra orangehb )){
				$fenetre_source{$s_mythtv}->Checkbutton(-text => $sce,
					-background => 'ivory',
					-command => sub {                                     
							$association_source{$sce}= $s_mythtv ;     # enregistrer les choix effectues
							})
					->pack( -anchor => 'w');
			}
		}
	
		$bottom_frame->Button(-text    => "OK",
			  -command => sub { message(1);
				  &afficher_mythconverg();
				},
			  -width    => 10,
			  -activebackground => 'green',
			 )->pack(-padx => 2, -pady => 4);
}

#  afficher les chaines trouvees dans mythconverg
sub afficher_mythconverg(){
		
	# si l'association des bouquets de mythtv et du fichier de config existe 
		if  (%association_source){
				%bouquets= %{retrieve($config_file) };
				&ReadDatabase ();
				$fenetre_message-> destroy ;
				
			# recharger l'arbre	
				&Remplir_arbre();
			
			#affiche les donnees dans la table (tablematrix)
				&supprimer_donnees_tableau();
				&afficher_list_chaine;
			
		}else{
			$fenetre_message-> destroy;
			&message (3);&message (3)}	
}


# mettre  a jour suite au changement de configuration
sub change_conf {
							print "change_conf\n" if $debug eq 1;
	if ($fichier_config eq 'Créer un nouveau fichier de configuration' ){
		&message(4);

=cut		
		if (-s $config_file) {
			my $text ="ATTENTION !\n\nIl existe déjà un fichier $config_file\nVous pouvez choisir d'utiliser ce fichier ou de\n\nle regénérer à  partir des données internet.\nVoulez-vous regénérer ce fichier ?\n\nATTENTION !\n\nCeci effacera votre fichier de configuration.";
			&ask_boolean ($text, sub {
						&message (1);                                                # lance le message de patience
						&configuration::creation_fichier_conf();          # lance le fichier configuration.pm
						$fenetre_message->destroy;                       # ferme le message de patience
						},,) ;   
		}
=cut
	}
	
	if ($fichier_config eq 'Télécharger le dernier fichier de configuration') {
		my $text ="ATTENTION !\n\nLa derniere version est disponible sur le site\n\nVoulez-vous télécharger ce fichier ?";
		&ask_boolean ($text, sub {
						&message (1);                                                # lance le message de patience
						&lister_chaines_de_configfile;
						$fichier_config = 'Utiliser le fichier de configuration existant' ;
						$fenetre_message->destroy;                       # ferme le message de patience
						},,) ;
		;
	}

	
	
	
	#affiche les donnees dans la table (tablematrix)
			&supprimer_donnees_tableau();
			&afficher_list_chaine;
}

# mettre  a jour suite au changement de configuration
sub change_conf1 {
							print "change_conf1\n" if $debug eq 1;
	# recharger la liste des bouquets sous forme de reference de hash
		%bouquets = ( );

		if ($action eq 'Utiliser les donnees de mythtv' ){
			&config_mythtv();
			
		}else{
			if ($action eq 'Modifier votre précèdente selection'and -e $ma_selection) {
				# remettre a zero le zone de configuration
					$type_num = "Aucun";
					@recuperateur= (0,'Aucun', 'Aucun', 'Aucun');
					$zone_recuperateur -> destroy ;
					&zone_recup;
				
				 %bouquets= %{retrieve($ma_selection) };
			 }
				
			%bouquets= %{retrieve($config_file) } if $action eq 'Créer une nouvelle selection'or !-e $ma_selection;
			
			$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")-> pack(-side => 'top' );
			%association_source = ();
			
		# recharger l'arbre	
			&Remplir_arbre();
		
		#affiche les donnees dans la table (tablematrix)
			&supprimer_donnees_tableau();
			&afficher_list_chaine;
				
		}
}
#
#---------------------------------------------------------
# routine de l'onglet statistique
#---------------------------------------------------------
	# contenu de l'onglet statistique
	sub statistique{
		if ($onglet_statistique){
			$onglet_statistique ->destroy;
			$onglet_statistique =();
			$onglet_statistique = $blocnote->add( "onglet_statistique", -label => "STATISTIQUES", );
		}
		if ($modif eq 0) {
			my $label_ch= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées")-> place (-y=>50,-x => 20);
			my $lab_nbr_ch= $onglet_statistique -> Label (-textvariable => \$stat{chaine_sel})->  place (-y=>50,-x => 400);
			my $label_numero= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées et numérotées")-> 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 sélectionnées 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 sélectionnées ayant une icone")-> place (-y=>110,-x => 20);
			my $lab_nbre_icone= $onglet_statistique -> Label (-textvariable => \$stat{logo} )->  place (-y=>110,-x => 400);
			my $label_modif_bd_xmltvid= $onglet_statistique -> Label (-text => "nombre de xmltvid modifié dans la base de données")-> 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 modifiées dans la base de données")-> 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 modifiés dans la base de données")-> 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 modifiés dans la base de données")-> place (-y=>210,-x => 20);
			my $lab_modif_bd_callsign= $onglet_statistique -> Label (-textvariable => \$compteur_bd_mythtv{callsign} )->  place (-y=>210,-x => 400);
		}
		else {
			my $label_ch= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées")-> place (-y=>50,-x => 2);
			my $lab_nbr_ch= $onglet_statistique -> Label (-textvariable => \$stat{chaine_sel})->  place (-y=>50,-x => 400);
			my $label_numero_tnt= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant une numérotation tnt")-> place (-y=>70,-x => 2);
			my $lab_nbre_numero_tnt= $onglet_statistique -> Label (-textvariable => \$stat{num_tnt} )->  place (-y=>70,-x => 400);
			my $label_numero_canalsat= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant une numérotation canalsat")-> place (-y=>90,-x => 2);
			my $lab_nbre_numero_canalsat= $onglet_statistique -> Label (-textvariable => \$stat{num_canal} )->  place (-y=>90,-x => 400);
			my $label_xmltvid_kazer= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant un xmltvid pour Kazer")-> place (-y=>110,-x => 2);
			my $lab_nbre_xmltvid_kazer= $onglet_statistique -> Label (-textvariable => \$stat{xmltvid_kazer} )->  place (-y=>110,-x => 400);
			my $label_xmltvid_mc2xml= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant un xmltvid pour mc2xml")-> place (-y=>130,-x => 2);
			my $lab_nbre_xmltvid_mc2xml= $onglet_statistique -> Label (-textvariable => \$stat{xmltvid_mc2xml} )->  place (-y=>130,-x => 400);
			my $label_xmltvid_telepoche= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant un xmltvid pour telepoche")-> place (-y=>150,-x => 2);
			my $lab_nbre_xmltvid_telepoche= $onglet_statistique -> Label (-textvariable => \$stat{xmltvid_telepoche} )->  place (-y=>150,-x => 400);
			my $label_xmltvid_telerama= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant un xmltvid pour telerama")-> place (-y=>170,-x => 2);
			my $lab_nbre_xmltvid_telerama= $onglet_statistique -> Label (-textvariable => \$stat{xmltvid_telerama} )->  place (-y=>170,-x => 400);
			my $label_xmltvid_iphone= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant un xmltvid pour iphone")-> place (-y=>190,-x => 2);
			my $lab_nbre_xmltvid_iphone= $onglet_statistique -> Label (-textvariable => \$stat{xmltvid_iphone} )->  place (-y=>190,-x => 400);
			my $label_icone= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant une icone")-> place (-y=>210,-x => 2);
			my $lab_nbre_icone= $onglet_statistique -> Label (-textvariable => \$stat{logo} )->  place (-y=>210,-x => 400);
			my $label_sid= $onglet_statistique -> Label (-text => "nombre de chaines sélectionnées ayant un sid")-> place (-y=>230,-x => 2);
			my $lab_nbre_sid= $onglet_statistique -> Label (-textvariable => \$stat{sid} )->  place (-y=>230,-x => 400);
		}
	}
	# compter le nombre d'occurence
	sub Compter_occurence () {
		foreach my  $j ( 'chaine_sel','name', 'source', 'bouquet', 'option','numero','num_tnt','num_canal',  'logo', 'sid', 'xmltvid_kazer','xmltvid_mc2xml', 'xmltvid_telepoche',
													'xmltvid','xmltvid_telerama','xmltvid_iphone', 'in_mythtv','modified_in_mythtv'){
			$stat{$j}= 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 de nombre de valeur par colonne
		my @titres =$liste_chaine->tagCell('titre_col');
		foreach my  $i (@titres){
			my $titre = $liste_chaine->get($i);
			my ($r, $c) = split(/,/, $i);

			for (my $k = 1; $k <= $stat {chaine_sel}; $k++){
				my $index_xmltvid = "$k,$c";
							$stat{$titre} ++ if $liste_chaine->get($index_xmltvid)
											and $liste_chaine->get($index_xmltvid) ne 'none'
											and $liste_chaine->get($index_xmltvid) ne '---';
			}
		}

	}
#
#
#---------------------------------------------------------
# routine du menu 
#---------------------------------------------------------

sub enregistrer_sous (){
	my $command = shift;
	#liste des formats acceptes
     my @types =(  );

	my$mon_fich = $fenetre_principale->getSaveFile(
                                                   -initialfile => 'sans titre',
                                                   -defaultextension => '');
	
	&sauvegarder_selection($mon_fich) if $command eq 'sauvegarder_selection';
	&sauvegarder_config_file($mon_fich) if $command eq 'sauvegarder_config_file';

}

# sauvegarder les donnees dans un fichier
sub sauvegarder_selection($){
	my $mon_fich = shift;
	if ($mon_fich ){
		my $text ="ATTENTION !\n\nLe fichier $mon_fich existe déjà\n\nVoulez-vous remplacer ce fichier ?\n\nATTENTION !";
		ask_boolean ($text, \&sauv_selection($mon_fich),, );
	}else{
		&sauv_selection($mon_fich);
	}
}


sub sauv_selection ($){
	my $mon_fich = shift;
	# enregistrer les donnees du tableau
		# Calcul du nombre de ligne dans le tableau
			my $number_row = $liste_chaine->cget( -rows );
		# enregistrer chaque ligne du tableau
			for my $row ( 1.. $number_row )
				{my $ch = $liste_chaine->get("$row,1");
				my $bq = $liste_chaine->get("$row,2");
				my $op = $liste_chaine->get("$row,3");
				my $sc = $liste_chaine->get("$row,8");
				$bouquets{$sc}{$bq}{$op}{$ch}{numero} = $liste_chaine->get("$row,4"); 
				$bouquets{$sc}{$bq}{$op}{$ch}{xmltvid}  = $liste_chaine->get("$row,5");
				$bouquets{$sc}{$bq}{$op}{$ch}{icone}    = $liste_chaine->get("$row,6");
				$bouquets{$sc}{$bq}{$op}{$ch}{sid}        = $liste_chaine->get("$row,7");
				$bouquets{$sc}{$bq}{$op}{$ch}{cocher} =1;
				$bouquets{$sc}{$bq}{$op}{$ch}{type_numero}= $type_num; 
			}
		#lancer la sauvegarde
			nstore ( \%bouquets, "$mon_fich")|| die "can't store to $mon_fich\n";
}

# sauvegarder les donnees dans un fichier
sub sauvegarder_config{
	my @cellules_modifiees =$liste_chaine->tagCell('modified');
			foreach my $cel (@cellules_modifiees){
				$modif_donnee++;
			}
	if ($modif_donnee > 0){
		my $text ="ATTENTION !\n\nvous avez modifié les donnes\n\nVoulez-vous continuer sans les sauvegarder ?\n\nATTENTION !";
		ask_boolean ($text, \&menu_configuration, ,\&sauvegarder_config_file );
	}else{
		&menu_configuration;
	}
	
}
# sauvegarder les modifications du fichier de configuration
sub sauvegarder_config_file ($){
	my $mon_fich = shift;
		my $text ="ATTENTION !\n\nLe fichier $mon_fich existe déjà\n\nVoulez-vous remplacer ce fichier ?\n\nATTENTION !";
	ask_boolean ($text, sub {
		# introduire les valeurs modifiees dans la base
			my @cellules_modifiees =$liste_chaine->tagCell('modified');
			foreach my $cel (@cellules_modifiees){
				my ($row, $col) = split (',', $cel );
				# retrouver les ancienne valeurs
					my $ch_old = $base_initial->{"$row,1"};
					my $bq_old = $base_initial->{"$row,3"};
					my $op_old = $base_initial->{"$row,4"};
					my $sc_old = $base_initial->{"$row,2"};
				#charger les nouvelles valeurs
					my $ch = $liste_chaine->get("$row,1");
					my $bq = $liste_chaine->get("$row,3");
					my $op = $liste_chaine->get("$row,4");
					my $sc = $liste_chaine->get("$row,2");
				# si le nom de bouquet de l'option ou du forunisseur est change, supprimer les ancienne valeurs dans le hash de hash	
					if ($ch ne $ch_old || $bq ne $bq_old || $op ne $op_old || $sc ne $sc_old){
						# supprimer les anciennes valeurs
							my $href = \%{$bouquets{$sc_old}{$bq_old}{$op_old}{$ch_old}};
							foreach my $k_ch_old (keys $bouquets{$sc_old}{$bq_old}{$op_old}){
								delete $bouquets{$sc_old}{$bq_old}{$op_old}{$k_ch_old} if  $bouquets{$sc_old}{$bq_old}{$op_old}{$k_ch_old}eq $href ;
							}
						# supprimer les parents vides	
							foreach  my $k_op_old (keys $bouquets{$sc_old}{$bq_old}){
								delete $bouquets{$sc_old}{$bq_old}{$k_op_old} if  keys $bouquets{$sc_old}{$bq_old}{$k_op_old}eq 0 ;
							}
						# supprimer les parents des parents vides	
							foreach  my $k_bq_old (keys $bouquets{$sc_old}){
								delete $bouquets{$sc_old}{$k_bq_old} if  keys $bouquets{$sc_old}{$k_bq_old}eq 0 ;
							}
						# supprimer les parents des parent des parent vides	
							foreach  my $k_sc_old (keys %bouquets){
								delete $bouquets{$k_sc_old} if  keys $bouquets{$k_sc_old} eq 0 ;
							}
						}	
							$bouquets{$sc}{$bq}{$op}{$ch}{name} = $ch;
							$bouquets{$sc}{$bq}{$op}{$ch}{option} = $op;
							$bouquets{$sc}{$bq}{$op}{$ch}{bouquet} = $bq;
							$bouquets{$sc}{$bq}{$op}{$ch}{source} = $sc;
							$bouquets{$sc}{$bq}{$op}{$ch}{numero_tnt} = $liste_chaine->get("$row,5");
							$bouquets{$sc}{$bq}{$op}{$ch}{numero_tnt_hd} = $liste_chaine->get("$row,6");
							$bouquets{$sc}{$bq}{$op}{$ch}{numero_canalsat} = $liste_chaine->get("$row,7");
							$bouquets{$sc}{$bq}{$op}{$ch}{numero_canalsat_hd} = $liste_chaine->get("$row,8");
							$bouquets{$sc}{$bq}{$op}{$ch}{numero_canalsat_new} = $liste_chaine->get("$row,9");
							$bouquets{$sc}{$bq}{$op}{$ch}{numero_canalsat_hd_new} = $liste_chaine->get("$row,10");
							$bouquets{$sc}{$bq}{$op}{$ch}{xmltvid_kazer}  = $liste_chaine->get("$row,11");
							$bouquets{$sc}{$bq}{$op}{$ch}{xmltvid_mc2xml}  = $liste_chaine->get("$row,12");
							$bouquets{$sc}{$bq}{$op}{$ch}{xmltvid_telepoche}  = $liste_chaine->get("$row,13");
							$bouquets{$sc}{$bq}{$op}{$ch}{xmltvid_telerama}  = $liste_chaine->get("$row,14");
							$bouquets{$sc}{$bq}{$op}{$ch}{xmltvid_iphone}  = $liste_chaine->get("$row,15");
							$bouquets{$sc}{$bq}{$op}{$ch}{icone}    = $liste_chaine->get("$row,16");
							$bouquets{$sc}{$bq}{$op}{$ch}{sid}        = $liste_chaine->get("$row,17");
							$bouquets{$sc}{$bq}{$op}{$ch}{cocher}        ='0';
						# enlever le tag "modified"
							$liste_chaine->tagCell( 'default', $cel);
							$modif_donnee = 0 ;
						# re-engistrer la valeur initial 	
							$base_initial->{"$cel"} = $liste_chaine->get("$cel");						
			}
			# sauvegarde de la config, de l'arbre et des chaine selectionnees
				$type_num_sauv = $type_num;
				@recuperateur_sauv= @recuperateur;
				$recuperateur_sauv[0] =1;
				%bouquets_sauv =%bouquets;
				%ma_selection_sauv = %ma_selection;
				
			# decocher les chaines avant de sauvegarder
				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) {
								my @list_chaines = sort keys %{$bouquets{$nom_source}{$nom_bouquet}{$nom_option}};
								for my $nom_chaine (@list_chaines) {
									$bouquets{$nom_source}{$nom_bouquet}{$nom_option}{$nom_chaine}{cocher} = 0;
								}
							}
					}						
				}
			
				
			# supprimer la ligne de titre
				delete $bouquets{source};	
				
			
			#lancer la sauvegarde
				nstore ( \%bouquets, "$mon_fich")|| die "can't store to $mon_fich\n";
			# effacer le tableau et recreer l'arborescence
				%bouquets =%bouquets_sauv;
				%ma_selection =( ) ;
#				$_data = {};
#				&supprimer_donnees_tableau ();
#				&Remplir_arbre();
#				&afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num);
	# imprimer la table de hash		
#		my $href3 = \%bouquets;
#		print "printing apres recharge\n";
#		print pp $href3, "\n";
#		print "\n";			

				&lister_chaines_de_configfile;
				&menu_modification;
# imprimer la table de hash		
#		my $href3 = \%bouquets;
#		print "printing apres menu modif\n";
#		print pp $href3, "\n";
#		print "\n";
#&afficher_list_chaine;
#&afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num);
	});
	# imprimer la table de hash		
		#my $href3 = \%bouquets;
		#print "printing HOH...\n";
		#print pp $href3, "\n";
		#print "\n";			
}

sub menu_configuration(){
						print "menu_configuration\n" if $debug eq 1;
	$modif =0;
	# recreer le menu
		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   => '~Ouvrir',  -accelerator => 'Ctrl+o',-command => sub{ my$mon_fich =$fenetre_principale->getOpenFile();
																						# charger la liste des bouquets sous forme de reference de hash
																							%bouquets= %{retrieve($config_file) };});
			$menu_fichier->command( -label   => '~Enregistrer ma sélection', -accelerator => 'Ctrl+s', -command =>  sub {&sauvegarder_selection($ma_selection) });
			$menu_fichier->command( -label   => '~Enregistrer sous',-accelerator => 'Ctrl+Alt+s',-command => sub{&enregistrer_sous('sauvegarder_selection')});
			$menu_fichier->command( -label   => '~Modifier les données',-accelerator => 'Ctrl+m', -command =>  \&menu_modification );
#			$menu_fichier->command( -label   => 'Enregistrer vos modifications',-state=> 'disable', -command =>  \&sauvegarder_config_file );	
#			$menu_fichier->command( -label   => 'Retour a la configuration', -state=> 'disable',-command =>  \&menu_configuration );
			$menu_fichier->separator;
			
			$menu_fichier->command( -label   => 'Quitter', -command => sub { exit;} );

	# menu chaines avec sous menu
		my $menu_tableau = $menu_bar->cascade( -label => 'Options', -tearoff => 0, );
			$menu_tableau->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_tableau->command( -label   => 'Effacer le tableau', -command => \&supprimer_donnees_tableau );
			$menu_tableau->command( -label   => 'Effacer tout', -command => \&supprimer_tout);

		# 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 ;
																			$WriteNum = 0 ;
																			WriteDatabase ();
																		});
			$menu_mythtv->separator;
			$menu_mythtv->command( -label   => 'Introduire les icones dans MythTV', -command => sub {
																			$WriteXmltvid = 0 ;
																			$WriteIcone = 1;
																			$WriteNum = 0 ;
																			WriteDatabase ();
																		});
			$menu_mythtv->separator;
			$menu_mythtv->command( -label   => 'Introduire la numérotation dans MythTV', -command => sub {
																			$WriteXmltvid = 0 ;
																			$WriteIcone = 0;
																			$WriteNum = 1 ;
																			WriteDatabase ();
																		});															
			
			$menu_mythtv->separator;
			$menu_mythtv->command( -label   => 'Introduire toutes les données dans MythTV', -command => sub {
																			$WriteXmltvid = 1;
																			$WriteIcone = 1;
																			$WriteNum = 1 ;
																			WriteDatabase ();
																		});
	

		# menu aide avec sous menu
			my $menu_aide = $menu_bar->cascade( -label => 'Aide', -tearoff => 0, );
			$menu_aide->command( -label   => 'Aide', );
			$menu_aide->command( -label   => 'Version', -command =>  sub {
				say("Configurateur de chaines TV \n\n\n Version   $version \n\n\n Crée par Gilles Choteau \n\n\n gillessoixantequatorze\@orange.fr \n");} );
	# commande raccourci du menu
		$fenetre_principale->bind('<Control-o>'=> sub{ $fenetre_principale->getOpenFile()});
		$fenetre_principale->bind('<Control-s>'=>sub {&sauvegarder_selection($ma_selection) });
		$fenetre_principale->bind('<Control-Alt-s>'=>sub{&enregistrer_sous('sauvegarder_selection') } );
		$fenetre_principale->bind('<Control-m>'=> \&menu_modification );
		

		
	# on vient de la fenetre de modif 
		if (!$onglet_configuration ){
			# recree l'onglet configuration
				$onglet_configuration = $blocnote->add( "onglet_configuration", -label => "CONFIGURATION", )if !$onglet_configuration;
				
				$onglet_selection -> destroy;
				$onglet_selection = ();
				$onglet_selection = $blocnote->add( "onglet_selection", -label => "VOTRE SELECTION", );
		}
		&creation_onglet_configuration ;
		&creation_onglet_selection;
			# reconstruire la tablematrix
				$tm = &configurer_tableau;
#&afficher_ma_selection($recuperateur_sauv[1],$recuperateur_sauv[2],$recuperateur_sauv[3], $type_num_sauv) if !@recuperateur_sauv eq ();
				&afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num);


				&Remplir_arbre ();
			# restaurer la ocnfiguration et des chaines choisies
				if ($recuperateur_sauv[0] eq 1){
#					$type_num=$type_num_sauv if $type_num_sauv ne '';
					@recuperateur=@recuperateur_sauv if $recuperateur_sauv[0] eq 1 ;
				}
			# supprimer avant de recreer les bas de page
				$label_accueil->destroy if $label_accueil;
				$lab_nbr_chaine->destroy if $lab_nbr_chaine;
				$label_chaine->destroy if $label_chaine;
				&bas_page;
				&statistique;
}

sub menu_modification(){
							print "menu_modification\n" if $debug eq 1;
	$modif =1;
	# recreer le menu
		my $menu_bar = $fenetre_principale->Menu( -type => "menubar",-background => 'yellow' );

		$fenetre_principale->configure( -menu => $menu_bar, );

		# menu fichier avec sous menu
			my $menu_fichier = $menu_bar->cascade( -label => 'Fichier',-background => 'yellow' , -tearoff => 0, );
			$menu_fichier->command( -label   => '~Enregistrer vos modifications', -accelerator => 'Ctrl+s', -background => 'yellow' ,-command => sub{ \&sauvegarder_config_file($config_file)} );
			$menu_fichier->command( -label   => '~Enregistrer sous', -accelerator => 'Ctrl+Alt+s',-background => 'yellow' , -command => sub{&enregistrer_sous('sauvegarder_config_file')});
			$menu_fichier->command( -label   => '~Retour a la configuration',-accelerator => 'Ctrl+r',  -background => 'yellow' ,-command => \&sauvegarder_config );
			$menu_fichier->command( -label   => 'Quitter',-state=> 'disable', -background => 'yellow' ,-command => sub { exit;} );
		# menu chaines avec sous menu
			my $menu_tableau = $menu_bar->cascade( -label => 'Options',-background => 'yellow' , -tearoff => 0, );
			$menu_tableau->command( -label   => 'Mettre a jour le tableau',-background => 'yellow' , -command => sub {
					&message(2) if (!$recuperateur[1]);
					&afficher_ma_selection($recuperateur[1],$recuperateur[2],$recuperateur[3], $type_num);
				});
			$menu_tableau->command( -label   => 'Effacer le tableau',-background => 'yellow' , -command => \&supprimer_donnees_tableau );
			$menu_tableau->command( -label   => 'Effacer tout', -background => 'yellow' ,-command => \&supprimer_tout);

		# menu chaine
			my $menu_chaine = $menu_bar->cascade( -label => 'Chaines', -tearoff => 0, );
			$menu_chaine->command( -label   => 'Ajouter une chaine',-background => 'yellow' ,-command => \&ajouter_chaine );
			$menu_chaine->command( -label   => 'Supprimer une chaine',-background => 'yellow' , -command => \&supprimer_chaine);
		# menu aide avec sous menu
			my $menu_aide = $menu_bar->cascade( -label => 'Aide', -tearoff => 0, );
			$menu_aide->command( -label   => 'Aide',-background => 'yellow' , );
			$menu_aide->command( -label   => 'Version',-background => 'yellow' , -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");} );
		# commande raccourci du menu
		$fenetre_principale->bind('<Control-r>'=> \&sauvegarder_config);
		$fenetre_principale->bind('<Control-s>'=> \&sauvegarder_config_file  );
		$fenetre_principale->bind('<Control-Alt-s>'=>sub{&enregistrer_sous('sauvegarder_config_file')} );
		$fenetre_principale->bind('<Control-m>'=> \&menu_modification );
			
	# recree le bas de page de la fenetre principale
		&bas_page;
	
	# supprimer l'onglet configuration
		$onglet_configuration->destroy if $onglet_configuration;
		$onglet_configuration =() ;

	# reconstruire la tablematrix
		$tm = &configurer_tableau;
		&remplir_tableau (); 
		&Remplir_arbre ();
	# reconstruire l'onglet statistique
		&statistique;

}

# dessiner le bas de page
sub bas_page(){
						print "bas_page\n" if $debug eq 1;
	my ($message_accueil,$color);	
	# recree le bas de page de la fenetre principale
		if ($modif eq 0){
			$message_accueil = "    Bienvenue dans le configurateur de chaines de Mythtv.fr         " ;
			$color ='white';
			# recree l'onglet configuration
#				$onglet_configuration = $blocnote->add( "onglet_configuration", -label => "CONFIGURATION", ) if ! $onglet_configuration;
		}else{
			$message_accueil = "    Bienvenue dans le configurateur de chaines de Mythtv.fr.                     Vous êtes dans la partie modification.        ";
			$color = 'yellow';
			# supprimer avent de recreer les bas de page
				$label_accueil->destroy;
				$lab_nbr_chaine->destroy;
				$label_chaine->destroy;
		}
		
		$label_accueil = $fenetre_onglets-> Label ( 
			-text       => $message_accueil,
			-background => $color,
			)->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 sélectionnées",-background => $color)-> pack(-side => 'right' );

}

# ajouter une chaine
sub ajouter_chaine {
	foreach my  $j ( 'name', 'source', 'bouquet', 'option','numero_tnt','numero_canalsat',  'icone', 'sid', 'xmltvid_kazer','xmltvid_mc2xml', 'xmltvid_telepoche',
													'xmltvid_telerama','xmltvid_iphone', 'in_mythtv','modified_in_mythtv'){
			$ma_selection{new}{$j} = '-' ;
		}
	&remplir_tableau;
}

# supprimer une chaine
sub supprimer_chaine{
	my $cel_active = $liste_chaine->tagCell('active');
	if ($cel_active){
		my ($r, $c) = split(/,/, $cel_active);
		my $ch = $liste_chaine->get("$r,1");
		my $bq = $liste_chaine->get("$r,3");
		delete $ma_selection{$ch,$bq};
		my $text ="ATTENTION !\n\nVoulez-vous vraiment supprimer la chaine $ch ?\n\nATTENTION !";
		ask_boolean ($text, sub {&remplir_tableau;});
	}
}

#---------------------------------------------------------
# routine generale
#---------------------------------------------------------

sub lister_chaines_de_configfile(){
							print "liste_chaines_de_configuration\n" if $debug eq 1;
		 if (!-e $config_file || -z $config_file) {
			open CONF, ">$config_file";#¦¦ die ("Erreur de creation de CONF") ;
			my $file= get("http://download.tuxfamily.org/mythtvarch/configuration/config_chaine");
			print CONF $file;
			close CONF;
		}
	# charger la liste des bouquets sous forme de reference de hash
		%bouquets= %{retrieve($config_file) };
		
=cut
	# fusion de fichier de config
		my $config_file1 ="$conf_dir/config_file.bak_tous satellites";
		my %bouquet1 =  %{retrieve($config_file1) };	
		my $config_file2 ="$conf_dir/config_file.modifie";
		my %bouquet2 =  %{retrieve($config_file2) };
		%bouquets = (%bouquet1,%bouquet2);
=cut
	#supprimer les bouquets mal nommees	
		delete $bouquets{Supprimer}; 
		delete $bouquets{supprimer}; 
		delete $bouquets{'---'}; 
		delete $bouquets{''};
		delete $bouquets{source};
#		delete $bouquets{'Satellite-Astra'};
#		delete $bouquets{'Satellite-Astra 19,2'};
#		delete $bouquets{Hertzien};
#		delete $bouquets{'Sat'}{canalsatfr};
#		delete $bouquets{'Sat'}{'Astra-free'};
}

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;
}



#recherche les sources definies dans mythtv
sub Recherche_source_mythtv () {
		&FindDatabase();                                   		# find the database
		my $connect = OpenDatabase();			# ouvrir la base de données
	# rechercher les source de mythtv
		my $query1 = "SELECT name FROM videosource  where name != NULL or name NOT like ".'""'.";";
		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;
	}


sub message{
	my $m =shift;
	my $texte="Veuillez patienter pendant l'exécution de votre commande...\n Cela peut prendre quelques dizaines de secondes,\n merci.\n" if ($m eq'1');
	$texte="Vous n'avez pas défini de récupérateur de programme" if ($m eq'2');
	$texte="Vous n'avez pas configuré l'interface avec Mythtv" if ($m eq'3');
	$texte="\nCette partie en actuellement en maintenance\n" if ($m eq'4');
	$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();
		
	$progress = $fenetre_message -> ProgressBar (
		- from         => 0,
		- to             => 1500,
		- length      => 300,
		- width        => 10,
		- colors       => [ 0, 'blue',],
		)  -> 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"or $m eq"4"){
		  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
	$E =~ tr/\x{94}/O/;                                                                          # pb franceO
	$E =~ s/AO/O/;
	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    => "Oui",
			  -command => sub { $main_window1->destroy;  &$command($option) ;},
			  -width => 10,
			 )->pack(-side => 'left', -padx => 2, -pady => 4);
	
        $bottom_frame->Button(-text    => "Non",
			  -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 () {
		&FindDatabase();                                   		# find the database
		my $connect = &OpenDatabase();			# ouvrir la base de données

	# lire des donnees de la base de donnees 
		my @liste_source_mythtv = Recherche_source_mythtv();
		$count = 0 ;
		foreach  my $Source_mythtv  (@source_mythtv)  {
			# recherche les source du fichier de config qui correspondent a la source de mythtv
				foreach my $source_sel (keys %association_source) {
					if ($association_source{$source_sel} eq $Source_mythtv ){
						# identifier toutes les chaines de la source de 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";
						# pour chaque chaine retrouver la source et l'option
							while (my @channame = $query_handle->fetchrow()){
								foreach my $chaine_mythtv (@channame) {
									$count++;	
								# nettoyer les nom de la chaine	
									my $idc =$chaine_mythtv ;
									$idc =~ s/Fr3/France 3/;
									$idc =~ s/ \?/ Ô/;
									$idc =~ s/Rhone/Rhone-Alpes/;
									$idc =~ s/CANAL/CANAL+/;
									$idc =~ s/\+\+/\+/;
									my $chaine_mythtv_clean = CleanNom ( $idc ) ;

									my $source_name = 'mythtv';
								# identifier le mode de diffusion a partir de la source 	
									foreach my $t (qw( bisab3 canalcaraibes canalsatfr fransat orangeab3 orangeastra orangehb) ){
										 $source_name = 'Satellite' if ($source_sel eq $t);
									}
									foreach my $t (qw( tnt_fr tntetrangere) ){
										 $source_name = 'Hertzien' if ($source_sel eq $t);
									}
								
									my $option_name = 'hors bouquet';
									
								# creer les chaines non inclus dans le bouquet
									if (! $ck_bt->{$source_sel,$chaine_mythtv_clean}->{source} ||
												$ck_bt->{$source_sel,$chaine_mythtv_clean}->{option}eq $option_name ){
										$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{source} = $source_name;
										$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{bouquet} = $source_sel ;
										$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{option} = $option_name ;										
										$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{name} = $chaine_mythtv_clean ;																		
									}else{
										$source_name = $ck_bt->{$source_sel,$chaine_mythtv_clean}->{source};
									}
									
									if (!$ck_bt->{$source_sel,$chaine_mythtv_clean}->{option}){
											$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{option} = $option_name ;
									}else{
									$option_name = $ck_bt->{$source_sel,$chaine_mythtv_clean}->{option};
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{option} = $option_name ;	
									}
									

								# marquer les chaines comme existantes dans mythtv
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{in_mythtv} = 1 if $source_name;
									
								# verifier que les chaines soient visibles
									my $query1 = "select channel.visible from channel , dtv_multiplex , videosource
												where channel.visible = dtv_multiplex.mplexid 
													and dtv_multiplex.sourceid = videosource.sourceid 
													and videosource.name = ".'"'.$Source_mythtv.'"'."
													and channel.name = ".'"'.$chaine_mythtv.'"'.";";
									my $query_handle1 = $connect->prepare($query);
									$query_handle1->execute()  || die "Unable to query channel table";	
									my @vis = $query_handle1->fetchrow();
								# marquer les chaines comme visibles dans mythtv
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{cocher} = 1 if (@vis and $source_name);
									
								# 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";
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{xmltvid} =()if (@vis and $source_name);;	
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{xmltvid} =  $query_handle1->fetchrow()if (@vis and $source_name);
									$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";
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{icone} =  $query_handle1->fetchrow()if (@vis and $source_name);
									$query_handle1->finish;
									
								# recuperer "numero"
									$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.'"'.";";
									$query_handle1 = $connect->prepare($query1);
									$query_handle1->execute()  || die "Unable to query channel table";
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{numero} =  $query_handle1->fetchrow()if (@vis and $source_name);
									$query_handle1->finish;	
									
								# recuperer "sid"
									$query1 = "select channel.serviceid 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";
									$bouquets{$source_name}{$source_sel}{$option_name}{$chaine_mythtv_clean}{sid} =  $query_handle1->fetchrow()if (@vis and $source_name);
									$query_handle1->finish;		
								
								
								# suppression des doublons dans les chianes de la TNT
									foreach my $s ( qw(tnt_fr tntetrangere)){
										if ($s eq $source_sel){
											foreach my $c ( qw(tnt_fr tntetrangere)){
												if ($c ne $source_sel){
													if ($ck_bt->{$c,$chaine_mythtv_clean}){
														delete $bouquets{$source_name}{$source_sel}{'hors bouquet'}{$chaine_mythtv_clean};
														delete $bouquets{$source_name}{$source_sel}{'hors bouquet'};
													}
												}
											}
										}
									}
								}
							}
						$query_handle->finish;
					}
				}
		}
}

sub WriteDatabase () {
	# verifier que la configuration de l'interface avec mythtv existe
		if  (%association_source){

			&Recherche_source_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, );
				}
		}else{&message (3);&message (3) ;&message (3);$onglet_configuration->focusForce}
}


sub modifier_database() {	
	my $Videosource_mythtv=shift;
	&message (1);
	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 = OpenDatabase();			# ouvrir la base de données
	my $item;
	
	&BackupDatabase();                               		# Sauvegarde base de données

	
	# rechercher les bouquets associes  la source video de mythtv
		foreach $source_selection(sort keys %association_source) {
			my $sc =$association_source{$source_selection};
			if ($sc eq $Videosource_mythtv) {

			# 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 = ".'"'.$Videosource_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 (@channame) {                           # pour chaque chaine de la base de donnees

						# nettoyer les nom de la chaine	
							my $idc =$chaine ;
							$idc =~ s/Fr3/France 3/;
							$idc =~ s/ \?/ Ô/;
							$idc =~ s/Rhone/Rhone-Alpes/;
							$idc =~ s/CANAL/CANAL+/;
							$idc =~ s/\+\+/\+/;
							my $chaine_mythtv_clean = CleanNom ( $idc ) ;
						if ($ma_selection{$chaine_mythtv_clean,$source_selection}){
							
							$dbvisible{$chaine} = "0";                          # rendre toutes les chaines invisibles

						# marquer les chaines comme  existante dans mythtv
							$ma_selection{$chaine_mythtv_clean,$source_selection}{in_mythtv}=1 ;
						

							my $channame = $ma_selection{$chaine_mythtv_clean,$source_selection}{name} ;
							$channame=~ s/\s+$//;
							$channame=~ s/^\s+//;

							my $channum=$ma_selection{$chaine_mythtv_clean,$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{$chaine_mythtv_clean,$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{$chaine_mythtv_clean,$source_selection}{xmltvid};
							$xmltvid=~ s/\s+$//;
							$xmltvid=~ s/^\s+//;

							my $sid=$ma_selection{$chaine_mythtv_clean,$source_selection}{sid};
							$sid=~ s/\s+$//;
							$sid=~ s/^\s+//;
							
						# prendre le sid de mythconverg pour les autres sources que le satellite
							my$query1 = "select channel.serviceid from channel , dtv_multiplex , videosource
								where channel.mplexid = dtv_multiplex.mplexid 
									and dtv_multiplex.sourceid = videosource.sourceid 
									and videosource.name = ".'"'.$Videosource_mythtv.'"'."
									and channel.name = ".'"'.$chaine.'"'.";";
									
							my$query_handle1 = $connect->prepare($query1);
							$query_handle1->execute()  || die "Unable to query channel table";
							$sid =  $query_handle1->fetchrow() if !($sc eq 'satellite');
							$query_handle1->finish;
						
							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{$chaine_mythtv_clean,$source_selection}{icone}) {
								my $iconloc=$ma_selection{$chaine_mythtv_clean,$source_selection}{icone};
								$iconloc =~ s/\s+$//;
								$iconloc =~ s/^\s+//;
	#							my $visible=$visible_map{$chaine_mythtv_clean};
	#							$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) {
			$compteur_bd_mythtv{xmltvid}= 0 ;   # remise a zero du compteur
			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 =   ".'"'.$Videosource_mythtv.'"'."
								and channel.serviceid = ".'"'.$dbsid{$item}.'"'."
								and channel.name = ".'"'.$item.'"'.";";
				my$query_handle = $connect->prepare($query);
				$query_handle->execute()  || die "Unable to query channel table";
				
			# marquer les chaines comme  modifees dans mythtv
				$item = CleanNom ( $item ) ;
				if ($query_handle->rows ne 0) {
#					$ma_selection{$item,$source_selection}{modified_in_mythtv} = 1 if $item ;
#					print "$item \t $source_selection \t $db_xmltvid{$item} \t $dbsid{$item} \n";
				}	
			}
		}
		
		if ($WriteIcone ne 0) {
			$compteur_bd_mythtv{icone} = 0 ;      # remise a zero du compteur
			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 =   ".'"'.$Videosource_mythtv.'"'."
							and channel.serviceid = ".'"'.$dbsid{$item}.'"'."
							and channel.name = ".'"'.$item.'"'.";";
				my$query_handle = $connect->prepare($query);
				$query_handle->execute()  || die "Unable to query channel table";
			}
		}

		if ($WriteNum ne 0 ) {
			$compteur_bd_mythtv{numero} = 0 ;     # remise a zero du compteur
			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 =   ".'"'.$Videosource_mythtv.'"'."
								and channel.serviceid = ".'"'.$dbsid{$item}.'"'."
								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 && $WriteNum ne 0 ) {
			$compteur_bd_mythtv{callsign} = 0 ;             # remise a zero du compteur
			$compteur_bd_mythtv{sup_invisible} = 0 ;     # remise a zero du compteur
			$compteur_bd_mythtv{sup_ss_nom} = 0 ;     # remise a zero du compteur
			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 =   ".'"'.$Videosource_mythtv.'"'."
								and channel.serviceid = ".'"'.$dbsid{$item}.'"'."
								and channel.name = ".'"'.$item.'"'.";";
				    my$query_handle = $connect->prepare($query);
				    $query_handle->execute()  || die "Unable to query channel table";
			}

			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 =   ".'"'.$Videosource_mythtv.'"'."
								and channel.serviceid = ".'"'.$dbsid{$item}.'"'."
								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 =   ".'"'.$Videosource_mythtv.'"'."
								and channel.serviceid = ".'"'.$dbsid{$item}.'"'."
								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 $query1 = "DELETE FROM channel WHERE name = ''" ;                                             # suppression des chaines sans nom
			my $query_handle1 = $connect->prepare($query1);
			$query_handle1->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");

&remplir_tableau () ;		

$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");
			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"; 
		}                                                                      
		elsif ( -e '/usr/local/share/mythtv/mythconverg_backup.pl')  {   
			system  "/usr/local/share/mythtv/mythconverg_backup.pl"  ;
		}    
		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 = <CONF>) {
				# 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;
}


=cut
version 0.2
	Externalisation du fichier de configuration
	Gestion des chaînes par option d'abonnement
	Possibilité de choisir la numérotation SD ou HD
	Ajout de la nouvelle numérotation CanalSat ( => 17 sept 2012)
	Téléchargement de la dernière version du fichier de configuration
	Ajout d'un mode modification
	Possibilité de modifier tous les champs
	Possibilité d'ajouter ou de supprimer une chaîne
	Possibilité de charger un autre fichier
	Possibilité de sauvegarder sous un autre nom
	Introduction sélective des données dans mythconverg
	Suppression provisoire de la reconstruction du fichier de configuration 
	Prise en compte de config.xml
	changement du nom du fichier de configuration pour config_chaine
=cut