#------------------------------------------------------------------------------------------------------------------------------------------------
package fw::tools;
#------------------------------------------------------------------------------------------------------------------------------------------------

@ISA = qw(Exporter);



@EXPORT= qw(

suicide
insert_file
get_file

to_ddmmyyyy
to_ansi_date

thumbnailize
thumbnailize_fixed



		       
			);

@EXPORTorig = qw(
       sql_line
       sql_lines
       sql_radios
       sql_listbox 
   
       suicide
			 insert_file
			 to_ddmmyyyy
			 to_ansi_date
			 http_redirect
			 get_quoted
			 upload_image
			 upload_file
			 thumbnailize
			 thumbnailize_fixed
			 get_file
       clean_url
			 send_mail
			 send_mail_with_attachment
			 inserth_db
			 updateh_db
			 execstmt
			 makeselecth	       
			 make_error
			 makebool
			 gethash
			 log_to
			 get_datecontrol
			 makeyearslist
			 dow
			 checkdate
			 getmaxday
			 is_bissextile
			 copy_image
			 makesortedselecth
			 makenumsortedselecth
			 remove_accents_from		 
			 make_url
			 make_pic
			 is_in
			 pdf_text
			 trim
			 ltrim
			 rtrim
			 clean_filename
       read_table
       select_table
       get_table
       get_table_hash
       get_var
       ajax_get_var
       ajax_get_last
       insert_table
       update_table
       truncate_table
       see
       dumper
       get_listbox_from_table
       split_datetime
       get_hash_from_config
       encode_html 
       is_int
       get_quoted_deutf8
       get_param_deutf8
       create_token


       remove_param_from_url
       
       serialize_hash_params
       
       sql_get_row_from_id
       sql_get_row_from_params
       sql_get_rows_array
       
       str_replace       
       see_array
       get_param_name
       cgi_redirect
       ajax_redirect
       
       get_hash_from_fields
       write_file
       reset_file
       sql_to_human_date
			);
use fw::env;        

use Data::Dumper;



#=============================================================================================================================================
# GET_FILE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# get the content of a file in a string
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS
#  0 : name of the file to get
# OUTPUT PARAMETERS
#  0 : content of the file
#==============================================================================================================================================
sub get_file
{
	my $filename = $_[0];
	my $content = "";

	open(FILE, $filename) or suicide ("GET_FILE : cannot open $filename");	
	
	while (<FILE>)
	{	
	   $content.= $_;
	}
	
	close(FILE);

	return $content;	
}

#==============================================================================================================================================
# PRINT_FILE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# display the content of a file
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : name of the file to display
# OUTPUT PARAMETERS
#  none
#==============================================================================================================================================
sub insert_file
{
	my $content = get_file($_[0]);
	print "$content";
}


#==============================================================================================================================================
# TO_DDMMYYY
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# convert ISO date (YYYY-MM-DD) to european format (DD-MM-YYYY)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : string containing the date in the ANSI format (YYYY-MM-DD)
# OUTPUT PARAMETERS
#  0 : a tring in the european format (DD/MM/YYYY) 
#==============================================================================================================================================
sub to_ddmmyyyy
{
	my $datetime = $_[0] || ""; 
	my $notime = $_[1] || ""; 
  my ($date,$time) = split(/ /,$datetime);
  my ($yyyy,$mm,$dd) = split (/-/,$date); 
  my ($h,$min,$sec) = split (/:/,$time); 
  my $result="";
  
  if ($notime eq "withtime") 
  {
      $result = "$dd/$mm/$yyyy, ".$h."h".$min;
  }
  elsif ($notime eq "withtimeandbr") 
  {
      $result = "$dd/$mm/$yyyy, <br />".$h."h".$min;
  }
  else
  {
	   $result = "$dd/$mm/$yyyy";	
  }
  return $result;	
}


#==============================================================================================================================================
# TO_ANSI_DATE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# convert european format (DD/MM/YYYY) to ISO date (YYYY-MM-DD)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : string containing the date in the european format (DD/MM/YYYY)
# OUTPUT PARAMETERS
#  0 : a tring in the ANSI format (YYYY-MM-DD)
#==============================================================================================================================================
	sub to_ansi_date
{
	my $date = $_[0];
	
	my ($dd,$mm,$yyyy) = split (/\//,$date);
	
	$date = "$yyyy-$mm-$dd";	
	
	return $date;	
}

#==============================================================================================================================================
# SUICIDE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# when an error occurs, display a nice message to the users
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : string containing the error message
# OUTPUT PARAMETERS
#  none (exit of the program)
#==============================================================================================================================================
sub suicide
{
	my $msg = $_[0]; 
    my $code = $_[1];

	my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller();
	
  use Carp;	
  my $stack = Carp::longmess("Stack backtrace :");


	my $errormsg = "";
	
  if ($is_web) {
	use fw::web;
	
$stack =~ s/\r*\n/<br>/g;			#Formatage de l'affichage de la chaine

  see();
	
	#Construction du message d'erreur
	$errormsg =  <<"EOM";
<html>
	<head

		<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
		<style type="text/css">*{background-color:#dd0000;font-family:courier new;}</style>
	</head>
<body>
	<h1>Guru Meditation</h1>
	<hr>
	<p><b>CODE : </b> $code </p>
</body>
EOM

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);	

	my $moment =  sprintf("[%04d-%02d-%02d:%02d:%02d:%02d]",$year+1900,$mon+1,$mday,$hour,$min,$sec); 
	

$errormsg = <<"EOT";
	<!--
		 $cfg{baseurl}
------------------------------------------------------------------------
		 $moment
		 $msg
------------------------------------------------------------------------
		 ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask)
		 [$stack]
-->
	</html>
EOT
  } else {
$errormsg = <<"EOT";
-------------------------------------------------------------------------------------
| Guru Meditation
-------------------------------------------------------------------------------------
Code :$code
-------------------------------------------------------------------------------------
$moment
$msg
-------------------------------------------------------------------------------------
		 ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask)
		 [$stack]
EOT
  }
	
  


	print "$errormsg";	
	
	exit();

}




#==============================================================================================================================================
# THUMBNAILIZE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a thumbnail of a picture  
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : name of the picture
#  1 : path of the picture
#  2 : maximum width
#  3 : maximum height
# OUTPUT PARAMETERS
#  0 : value of the parameter, with ' quoted
#==============================================================================================================================================
sub thumbnailize
{
	use GD;		#Interface Ó la librairie graphique GD
	GD::Image->trueColor(1);	#Dois utiliser les couleurs vrai. Chaque pixels de l'image sera codÚ sur 3 bytes et non 1.

	my $filename = $_[0];	#Nom de l'image
	my $upload_path = $_[1];	#Chemin absolu de cette image
	my $th_width = $_[2];	#Longeur maximum dÚsirÚ
	my $th_height = $_[3];	#Hauteur maximum dÚsirÚ
  my $th_suffix = $_[4] || "_thumb";
  if ($th_suffix eq " ") {$th_suffix = "";}
    my $other_dir = $_[5] || "";

  my $initial_th_height=$th_height;
  
	my $fullname = $upload_path."/".$filename;	#Nom complet du fichier

	my @splitted = split(/\./,$filename);	#DÚcoupage du nom du fichier
	my $ext = pop @splitted;	#Copie du dernier ÚlÚment qui est l'extension du fichier
	
	my $thumb_url = join(".",@splitted)."$th_suffix.".$ext;	#Reformation du nom du fichier qui sera enregistrer sur le serveur
       if ($other_dir ne "") {$upload_path=$other_dir;}
	my $thumb_filename = $upload_path."/".$thumb_url;	#Formation de l'adresse absolue de l'image

	my $error =  GD::Image->new($fullname) || 'error';
	if($error eq 'error')
	{
		return 'error';
	}
	
	my $full = GD::Image->new($fullname) || suicide("GD cannot open $fullname : [$!]");		#CrÚation d'une nouvelle image

	my ($fu_width,$fu_height) = $full->getBounds();		#RÚcupÚration de la longueur et de la hauteur de l'image reþue en paramÞtre
  my ($transparent) = $full->transparent();		#RÚcupÚration de la couleur transparente
	my $prop = 1;	#Proportion de l'image

	if ($th_width > $fu_width) {$th_width = $fu_width;} #Si la longueur dÚsirÚ > grande que la longueur rÚelle
	if ($th_height > $fu_height) {$th_height = $fu_height;}	#Si la hauteur dÚsirÚ > grande que la hauteur rÚelle

	if ($fu_width >= $th_width && $fu_height >= $th_height) 
	{
	    if ($fu_width > $fu_height) 
		{
	        $prop = $fu_width / $th_width;	#Proportion des mesures de l'image rÚelle et l'image dÚsirÚe
	        $th_height = int ($fu_height / $prop);	#Redimensionnement de la hauteur en gardant la proportion longueur/hauteur
	        
	        #si la hauteur de la miniature calculÚe dÚpasse la hauteur maximum voulue pour la hauteur
	        if($th_height > $initial_th_height)
	        {
	             my $prop2=$initial_th_height/$th_height;
	             $th_width*=$prop2;
	             $th_height=$initial_th_height;
          }
	    } 
		else 
		{
	        $prop = $fu_height / $th_height;
	        $th_width = int ($fu_width / $prop);
	    }
	}

	my $thumb = GD::Image->new($th_width,$th_height,1);	#CrÚation d'une image avec les nouvelles valeurs proportionnelle
	



	$thumb->saveAlpha(1);
	$thumb->alphaBlending(0);
#	$thumb->transparent($transparent);
 	$thumb->copyResampled($full,0,0,0,0,$th_width,$th_height,$fu_width,$fu_height);	#Copie de l'image
	

	my $data;
	
	if ($ext =~ /[Jj][Pp][Ee]*[Gg]/) #Test de l'extension
	{
	    $data = $thumb->jpeg(100); 
	} 
	elsif ($ext =~ /[Pp][Nn][Gg]/) 
	{
#      $thumb->transparent($transparent);		#RÚcupÚration de la couleur transparente
	    $data = $thumb->png; 
	}

	open (THUMB,">$thumb_filename");	#Ouverture du fichier
	binmode THUMB;	#Mode binaire
	print THUMB $data;	#Enregistrement du fichier
	close THUMB;	#Fermeture

	return ($thumb_url,$th_width,$th_height,$fu_width,$fu_height);	#Retourne le nouveau nom du fichier et les informations sur la taille
}



#==============================================================================================================================================
# THUMBNAILIZE FIXED
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a thumbnail of a picture  
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : name of the picture
#  1 : path of the picture
#  2 : maximum width
#  3 : maximum height
#  4 : fix a dimension
# OUTPUT PARAMETERS
#  0 : value of the parameter, with ' quoted
#==============================================================================================================================================
sub thumbnailize_fixed
{
	use GD;		#Interface Ó la librairie graphique GD
	GD::Image->trueColor(1);	#Dois utiliser les couleurs vrai. Chaque pixels de l'image sera codÚ sur 3 bytes et non 1.

	my $filename = $_[0];	#Nom de l'image
	my $upload_path = $_[1];	#Chemin absolu de cette image
	my $th_width = $_[2];	#Longeur maximum dÚsirÚ
	my $th_height = $_[3];	#Hauteur maximum dÚsirÚ
  my $th_suffix = $_[4] || "_thumb";
  my $fixed_dimension = $_[5] || "fixed_height";
  my $from_path = $_[6] || $filename;
  
#   print "<br />[$th_suffix][$fixed_dimension][$th_width][$th_height]";
  
  
	my $fullname = $from_path."/".$filename;	#Nom complet du fichier

	my @splitted = split(/\./,$filename);	#DÚcoupage du nom du fichier
	my $ext = pop @splitted;	#Copie du dernier ÚlÚment qui est l'extension du fichier
	
	my $thumb_url = join(".",@splitted)."$th_suffix.".$ext;	#Reformation du nom du fichier qui sera enregistrer sur le serveur
	my $thumb_filename = $upload_path."/".$thumb_url;	#Formation de l'adresse absolue de l'image

	my $full = GD::Image->new($fullname) || suicide("GD cannot open $fullname : [$!]");		#CrÚation d'une nouvelle image
	my ($fu_width,$fu_height) = $full->getBounds();		#RÚcupÚration de la longueur et de la hauteur de l'image reþue en paramÞtre
#  my ($transparent) = $full->transparent();		#RÚcupÚration de la couleur transparente





	my $prop = 1;	#Proportion de l'image

	if($th_width > $fu_width) {$th_width = $fu_width;} #Si la longueur dÚsirÚ > grande que la longueur rÚelle
	if($th_height > $fu_height) {$th_height = $fu_height;}	#Si la hauteur dÚsirÚ > grande que la hauteur rÚelle
  
  my $decallage_x=0;
  my $decallage_y=0;
  my $thumb = GD::Image->new($th_height,$th_height);	#CrÚation d'une image avec les nouvelles valeurs proportionnelle
#   print "----> $fixed_dimension";
	if($fixed_dimension eq "fixed_height") 
	{
# 	  print "fu_width: $fu_width, fu_height: $fu_height";
    if($fu_width > $fu_height) 
		{
# 	        $prop = $fu_width / $fu_height;
          $prop = $fu_height / $fu_width ;		
	        $th_height = int ($prop * $th_height);
# 	        print " th width: $th_width";
	  } 
		else 
		{
	        $prop = $fu_height / $fu_width;	
	        $th_width = int ($th_height/$prop);
# 	        print " th width2: $th_width";
	  }
# 	  print "th_width: $th_width, th_height: $th_height";
	  
    $thumb = GD::Image->new($th_width,$th_height);	#CrÚation d'une image avec les nouvelles valeurs proportionnelle
#  	$thumb->transparent($transparent);
	$thumb->saveAlpha(1);
	$thumb->alphaBlending(0);
	  $thumb->copyResampled($full,0,0,0,0,$th_width,$th_height,$fu_width,$fu_height);
	}
	elsif($fixed_dimension eq "fixed_height_width") 
	{
    if($fu_width > $fu_height) 
		{
	        
# 	        print "[$fu_width][$fu_height][$th_width][$th_height]";
# 	        exit;
          
          $prop = $fu_width / $fu_height;	
	        $th_width = int ($prop * $th_height);
	        $thumb = GD::Image->new($th_height,$th_height);	#CrÚation d'une image avec les nouvelles valeurs proportionnelle
    #    	$thumb->transparent($transparent);
    	$thumb->saveAlpha(1);
	$thumb->alphaBlending(0);
	        $thumb->copyResampled($full,0,0,0,0,$th_width,$th_height,$fu_width,$fu_height);
	  } 
		else 
		{
	        $prop =  $fu_height / $fu_width;	
          $th_width=$th_height;
	        my $th_height_debordant=$prop * $th_height;
	        $thumb = GD::Image->new($th_width,$th_height);	#CrÚation d'une image avec les nouvelles valeurs proportionnelle
     #    	$thumb->transparent($transparent);
     	$thumb->saveAlpha(1);
	$thumb->alphaBlending(0);
	        $thumb->copyResampled($full,0,0,0,0,$th_width,$th_height_debordant,$fu_width,$fu_height);
	  }
  }
  
#   see();
#   print "fin";
#   exit;

	#Copie de l'image

	my $data;
	
	if ($ext =~ /[Jj][Pp][Ee]*[Gg]/) #Test de l'extension
	{
	    $data = $thumb->jpeg(100); 
	} 
	elsif ($ext =~ /[Pp][Nn][Gg]/) 
	{
#     $thumb->transparent($transparent);		#RÚcupÚration de la couleur transparente
	    $data = $thumb->png; 
	}

	open (THUMB,">$thumb_filename");	#Ouverture du fichier
	binmode THUMB;	#Mode binaire
	print THUMB $data;	#Enregistrement du fichier
	close THUMB;	#Fermeture

	return ($thumb_url,$th_width,$th_height,$fu_width,$fu_height);	#Retourne le nouveau nom du fichier et les informations sur la taille
}



sub get_hash_from_fields
{
    my @fields_web = @{$_[0]};
    my @fields_sql = @{$_[1]};
    my %d = %{$_[2]};
    
    my %new_hash = ();
    my $counter = 0;
    foreach $field (@fields_web)
    {
        $new_hash{$fields_sql[$counter]} = get_quoted($field) || $d{$field} || "";
#         $new_hash{$fields_sql[$counter]} =~ s/\'/\\\'/g;
        $counter++;
    }
    return \%new_hash;
}

#==============================================================================================================================================
# SEND_MAIL
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# send an email 
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : "from" email address
#  1 : "to" email address
#  2 : subject of the email
#  3 : body of the email
#  4 : type of the body (html or something else)
# OUTPUT PARAMETERS
#  none
#==============================================================================================================================================
sub send_mail
{
    my $adr_from = $_[0];
  	my $adr_to = $_[1];
  	my $subject = $_[2];
  	my $body = $_[3];
  	my $type = $_[4];
  	my $charset = $_[5] || 'UTF-8';
    
    if($config{send_mail_version} == 2)
    {
         send_mail_v_2({
                            adr_from      => $adr_from,
                            adr_to        => $adr_to,
                            subject       => $subject,
                            body          => $body,
                            type          => $type,
                            charset       => $charset
                       });
    }
    else
    {
        if($type eq "html") 
        {$type = "Content-type:text/html";}	
      	else 
        {$type = "Content-type:text/plain";}
        
        if ($charset ne "") {$type.= ";charset=$charset";} 
         $type.="\r\nMIME-Version: 1.0\r\nContent-Transfer-Encoding: 8bit";
        
        $sender = new Mail::Sender;   
        ref $sender->Open({from=>"$adr_from",to =>"$adr_to", subject => "$subject", headers=>"$type"}) or die "Error: $Mail::Sender::Error\n";
        my $FH = $sender->GetHandle();
        print $FH $body;
        $sender->Close;
    }
}

sub send_mail_v_2
{
    my %d = %{$_[0]};
    use MIME::Lite;
    
    my $type = 'text/plain';
    if($d{type} eq 'html')
    {
        $type = 'text/html';
    }
    $msg = MIME::Lite->new
    (
       From     =>$d{adr_from},
       To       =>$d{adr_to},
       Subject  =>$d{subject},
       Type     =>$d{type},
       Encoding =>'8bit', 
       Data     =>'',
    );
                 
    $msg->attach
    (
       Type => $type.'; charset=UTF-8',
       Data => $d{body}
    );

    $msg->send();
}

#==============================================================================================================================================
# SEND_MAIL_WITH_ATTACHMENT
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# send an email with attachement
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : "from" email address
#  1 : "to" email address
#  2 : subject of the email
#  3 : body of the email
#  4 : path to attachment
#  5 : type of the body (html or something else)
# OUTPUT PARAMETERS
#  none
#==============================================================================================================================================
sub send_mail_with_attachment
{
	my $adr_from = $_[0];
	my $adr_to = $_[1];
	my $subject = $_[2];
	my $body = $_[3];
	my $attachment = $_[4];
	my $type = $_[5];
	
	if ($type eq "html") {$type = "Content-type:text/html";}	#DÚfinition du type d'email
	else {$type = "Content-type:text/plain";}

use Mail::Sender;





    $sender = new Mail::Sender;

(ref ($sender->MailFile(
  {
   from=>$adr_from,
   to =>$adr_to,
   subject => $subject,
   msg => $body,
   file => $attachment
  }))
 )
 or die "$Mail::Sender::Error\n";

}





#==============================================================================================================================================
# MAKESELECTH
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a listbox from a hash (unsorted)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : hash ref to names/values
#  1 : pre-selected name/value
# OUTPUT PARAMETERS
#==============================================================================================================================================
sub makeselecth
{
	 my %list=%{$_[0]};
	 my $already = $_[1];

	 my $options = "";
	 my $selected = "";

	 my @list = sort keys(%list);

	foreach $v (@list)
	{
		if ($already eq $v)
		{
	        $selected = "selected=\"selected\"";
	    }
	    else
	    {
			$selected = "";
	    }
	    
		$options .= "<option value=\"$v\" $selected>$list{$v}</option>\n";
	}

	 return $options;
}


#==============================================================================================================================================
# MAKESORTEDSELECTH
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a listbox from a hash (sorted)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : hash ref to names/values
#  1 : pre-selected name/value
# OUTPUT PARAMETERS
#  0 : the <option> tags with values
#==============================================================================================================================================
sub makesortedselecth
{
	 my %list=%{$_[0]};
	 my $already = $_[1];

	 my $options = "";
	 my $selected = "";

	 my @list = (sort { $list{$a} cmp $list{$b} } keys %list) ;

	 foreach $v (@list)
	 {
	    if ($already eq $v) 
		{
	        $selected = "selected=\"selected\"";
	    } 
		else 
		{
	        $selected = "";
	    }
	    
		$options .= "<option value=\"$v\" $selected>$list{$v}</option>\n";
	 }

	 return $options;
}


#==============================================================================================================================================
# MAKENUMSORTEDSELECTH
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a listbox from a hash (numerically sorted)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : hash ref to names/values
#  1 : pre-selected name/value
# OUTPUT PARAMETERS
#  0 : the <option> tags with values
#==============================================================================================================================================
sub makenumsortedselecth
{
	 my %list=%{$_[0]};
	 my $already = $_[1];

	 my $options = "";
	 my $selected = "";

	 my @list = (sort { $a <=> $b } keys %list) ;

	 foreach $v (@list)
	 {
	    if ($already eq $v) 
		{
	        $selected = "selected=\"selected\"";
	    } 
		else 
		{
	        $selected = "";
	    }
	    
		$options .= "<option value=\"$v\" $selected>$list{$v}</option>\n";
	 }

	 return $options;
}

#==============================================================================================================================================
# MAKEDAYSLIST
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a listbox containing a list of days (1 to 31)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : pre-selected day 
# OUTPUT PARAMETERS
#  0 : the <option> tags with values
#==============================================================================================================================================
sub makedayslist
{
	 my $already = $_[0];
	 my $list = "";

	 for ($i = 1; $i <= 31; $i++)
	 {
	     if ($i <10) {$j = "0".$i;}
	     else {$j=$i;}
		 
	     if ($already eq $j) 
		 {
	         $selected = "SELECTED";
	     } 
		 else 
		 {
	         $selected = "";
	     }
	     
		 $list .= "<OPTION VALUE=\"$j\" $selected>$i\n";
	 }
	 
	 return $list;
}

#==============================================================================================================================================
# MAKEYEARSLIST
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a listbox containing a list of years
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : pre-selected year (the start and end year are configured in global cfg)
# OUTPUT PARAMETERS
#  0 : the <option> tags with values
#==============================================================================================================================================
sub makeyearslist
{
	 my $already = $_[0];

	 if ($config{start_year} eq "") {$config{start_year} = 1900;}
	 if ($config{end_year} eq "") {$config{end_year} = 2010;}
	 
	 my $list ="";
	 for ($i = $config{start_year}; $i <= $config{end_year}; $i++) 
	 {
	     if ($already eq $i) 
		 {
	         $selected = "SELECTED";
	     } 
		 else 
		 {
	         $selected = "";
	     }
	     
		 $list .= "<OPTION VALUE=\"$i\" $selected>$i\n";
	 }
	 
	 return $list;
}


#==============================================================================================================================================
# MAKEBOOL
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a boolean control with checkbox
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : title to display after the checkbox
#  1 : name of the field
#  2 : y if the box is pre-checked
# OUTPUT PARAMETERS
#  0: string containing HTML field
#==============================================================================================================================================
sub makebool
{
	 my $title = $_[0];
	 my $name = $_[1];
	 my $already = $_[2];
	 my $checked = "";
	 
	 if ($already eq 'y') 
	 {
	     $checked = "CHECKED";
	 } 
	 else 
	 {
	     $checked = "";
	 }
	 
	 my $list = "<input type=\"checkbox\" name=\"$name\" value=\"y\" $checked>$title\n";

	 return $list;
}

#==============================================================================================================================================
# GET_DATACONTROL
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# create a 3-listbox control for selecting a date
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : pre-selected date (ANSI format YYYY-MM-DD). If none, take current date
#  1 : unique ID representing the control (generally incremental number)
#  2 : name of the hidden field containing the selected date for later use
# OUTPUT PARAMETERS
#  0: string containing HTML fields and JS code
#==============================================================================================================================================
sub get_datecontrol
{
	 my $origdate = $_[0] || "";	#la date prÚsÚlectionner
	 my $id = $_[1];	#id reprÚsentant le control
	 my $fieldname = $_[2];	#le nom du champ cachÚ contenant la date sÚlectionner pour une utilisation aprÞs

	 if ($origdate eq "") 
	 {
	     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);	#prise de la date actuelle
	     $origdate = sprintf("%04d-%02d-%02d",$year+1900,$mon+1,$mday);	#Formatage de la date
	 }
	 
	 my ($yyyy,$mm,$dd) = split(/\-/,$origdate);	#DÚcoupage de la date
	 my $dayslist = makedayslist($dd);	#Appel Ó la fonction makedayslist
	 my $monthlist = makenumsortedselecth(\%{$fwtrad{monthlist}},$mm);	#Appel Ó la fonction makeselecth
	 my $yearslist = makeyearslist($yyyy); #Appel Ó la fonction makeyearslist
	 
	 
	 #CrÚation du code html et javascript insÚrer dans la page
	 my $control = <<"EOH";
			<script type="text/javascript">
			<!--
			function sethiddendate$id()
			{
				 lyyyy = document.getElementsByName("yyyy_$id");
				 lmm = document.getElementsByName("mm_$id");
				 ldd = document.getElementsByName("dd_$id");

				 mydate =
				 lyyyy.item(0).options[lyyyy.item(0).options.selectedIndex].value + "-" +
				 lmm.item(0).options[lmm.item(0).options.selectedIndex].value + "-" +
				 ldd.item(0).options[ldd.item(0).options.selectedIndex].value;
				 
				 
				 document.getElementsByName("$fieldname").item(0).value = mydate;
			}
			//-->
			</script>
			<select name="dd_$id" onchange="sethiddendate$id();">$dayslist</select>
			<select name="mm_$id" onchange="sethiddendate$id();">$monthlist</select>
			<select name="yyyy_$id" onchange="sethiddendate$id();">$yearslist</select>
			<input type="hidden" name="$fieldname" value="$origdate" />
EOH

	 return $control;	#Retourne le code html
}


#==============================================================================================================================================
# GETHASH (nothing to do with marijuana :-))
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# make readable the content of any given perl hash
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : hash ref to display
# OUTPUT PARAMETERS
#  0: human readable string
#==============================================================================================================================================
sub gethash
{
	 my %hash = %{$_[0]};
	 my $txt = "";
	 my ($k,$v);
	 while ( ($k,$v) = each %hash ) { 
	 
	 if (ref($v) eq "HASH") 
	 {
		$v = gethash($v);
	 }
	 elsif (ref($v) eq "ARRAY") 
	 {
		$v = join(',',@{$v});
	 }
	 
	 $txt.= "[$k]=>[$v]<BR>";}
	 
	 return $txt;
}

#==============================================================================================================================================
# log_to
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# write any given string to the log file with current timestamp
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : text to write
# OUTPUT PARAMETERS
#  none
#==============================================================================================================================================
sub log_to
{
	 my $txt = $_[0];
	 
	 if ($config{debug_mode} eq "y") 
	 {
	     my $file = $config{logfile} || "default.log";
	     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

	     open (LOGFILE,">>$file");
	     print LOGFILE sprintf("[%04d-%02d-%02d:%02d:%02d:%02d]",$year+1900,$mon+1,$mday,$hour,$min,$sec)."[$txt]\n";
		 close (LOGFILE);
	 }
}


#==============================================================================================================================================
# DOW
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# tells the day of week of a given date
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : day to test
#  1 : month to test
#  2 : year  to test
# OUTPUT PARAMETERS
#  0 : day of the week
#==============================================================================================================================================
sub dow
{
	 my $jour=$_[0], $mois=$_[1], $annee=$_[2];

	 my $a = int((14 - $mois) / 12);

	 my $y = $annee - $a;

	 my $m = $mois + (12*$a) - 2;

	 my $d = int( $jour + $y + int($y/4) - int($y/100) + int($y/400) + int((31*$m)/12))%7;

	 return $d;
}


#==============================================================================================================================================
# CHECKDATE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# check validity of a given date
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : day to test
#  1 : month to test
#  2 : year  to test
# OUTPUT PARAMETERS
#  0 : 1 if date is valid, otherwise 0
#==============================================================================================================================================
sub checkdate
{
	 my $jour=$_[0];
	 my $mois=$_[1];
	 my $annee=$_[2];
	 my $nbjour = "";

	 if ($annee<1600 || $annee>3000) 
	 {
	     return 0;
	 }
	 else 
	 {
	     if ($mois<1 || $mois>12) 
		 {
			 return 0;
		 } 
		 else 
		 {
	         $nbjour = getmaxday($mois,$annee);
	         
		    if ($jour<1 || $jour>$nbjour) 
			{
				 return 0;
			} 
			else 
			{
				 return 1;
			}
		 }
	 }
}

#==============================================================================================================================================
# GETMAXDAY
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# get the number of days in a month
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : month to test
#  1 : year of the month to test
# OUTPUT PARAMETERS
#  0 : number of days of the given month
#==============================================================================================================================================
sub getmaxday
{
	 my $mois = $_[0];
	 my $annee = $_[1];
	 my $nbjour = "";

	 if ($mois==4 || $mois==6 || $mois==9 || $mois==11) {
	     $nbjour=30;
	 } else {
	     if ($mois!=2) {
	         $nbjour=31;
	     } else {
		       if (is_bissextile($annee)) {
					     $nbjour=29;
					 } else {
	          	 $nbjour=28;
					 }
	     }
	 }
	 
	 return $nbjour;
}

#==============================================================================================================================================
# IS_BISSEXTILE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# tell if the given year is leap or not (bissextile = leap in french)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : year to test
# OUTPUT PARAMETERS
#  0 : 1 if year if leap, otherwise 0
#==============================================================================================================================================
sub is_bissextile
{
	 my $annee = $_[0];

	 if (($annee%400)==0) {return 1;}
	 if (($annee%100)==0) {return 0;}
	 if (($annee%4)==0) {return 1;}
	 return 0;
}

#==============================================================================================================================================
# COPY_IMAGE
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# copy a picture (= cp command), renaming it with current timestamp
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : filename to copy
#  1 : new path of the file
# OUTPUT PARAMETERS
#  0 : path to new file
#==============================================================================================================================================
sub copy_image
{
	 my $in_filename = $_[0];
	 my $upload_path = $_[1];

	 my ($file_url);

	 if ($in_filename eq "") { return ""; }
	 
	 my @splitted = split(/\./,$in_filename);
	 my $ext = $splitted[$#splitted];

	 # build unique filename from current timestamp
	 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	 $year+=1900;
	 $mon++;
	 
	 my @chars = ( "A" .. "Z", "a" .. "z");
	 my $string = join("", @chars[ map { rand @chars } ( 1 .. 3 ) ]);

	 $file_url = "$year$mon$mday$hour$min$sec$string".".".$ext;

	 # add the target directory
	 my $out_filename = $upload_path."/".$file_url;

	 system ("cp $in_filename $out_filename");

	 return ($file_url);
}


#==============================================================================================================================================
# REMOVE_ACCENTS_FROM
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# transform a string to delete all accentuated chars (ex : Ú => e)
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : string to modify
# OUTPUT PARAMETERS
#  0 : modified string
#==============================================================================================================================================
sub remove_accents_from
{
	 my $str = $_[0];
	 
	 my %accents = ("¥" => "Y", "µ" => "u", "À" => "A", "Á" => "A", 
	                "Â" => "A", "Ã" => "A", "Ä" => "A", "Å" => "A", 
	                "Æ" => "A", "Ç" => "C", "È" => "E", "É" => "E", 
	                "Ê" => "E", "Ë" => "E", "Ì" => "I", "Í" => "I", 
	                "Î" => "I", "Ï" => "I", "Ð" => "D", "Ñ" => "N", 
	                "Ò" => "O", "Ó" => "O", "Ô" => "O", "Õ" => "O", 
	                "Ö" => "O", "Ø" => "O", "Ù" => "U", "Ú" => "U", 
	                "Û" => "U", "Ü" => "U", "Ý" => "Y", "ß" => "s", 
	                "à" => "a", "á" => "a", "â" => "a", "ã" => "a", 
	                "ä" => "a", "å" => "a", "æ" => "a", "ç" => "c", 
	                "è" => "e", "é" => "e", "ê" => "e", "ë" => "e", 
	                "ì" => "i", "í" => "i", "î" => "i", "ï" => "i", 
	                "ð" => "o", "ñ" => "n", "ò" => "o", "ó" => "o", 
	                "ô" => "o", "õ" => "o", "ö" => "o", "ø" => "o", 
	                "ù" => "u", "ú" => "u", "û" => "u", "ü" => "u", 
	                "ý" => "y", "ÿ" => "y"
				);

	 foreach $char (keys(%accents)) {
	     $str =~ s/$char/$accents{$char}/g;
	 }

	return $str;
}

#==============================================================================================================================================
# MAKE_URL
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# transform the url and a text in a <A> tag
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : url
#  1 : text to display
# OUTPUT PARAMETERS
#  0 : string containing the a element
#==============================================================================================================================================
sub make_url
{
	 my $url = $_[0];
	 my $name = $_[1];
	 
	 return "<a href=\"$url\">$name</a>";
}

#==============================================================================================================================================
# MAKE_PIC
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# transform the url of a picture in a <IMG> tag
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : url
# OUTPUT PARAMETERS
#  0 : string containing the img element
#==============================================================================================================================================
sub make_pic
{
	 my $url = $_[0];
	 
	 return "<img src=\"$url\" />";
}

sub is_int
{
  my $value=$_[0];
  if($value =~ /^\d+$/)
  {
    return 1;
  }
  else
  {
    return 0;
  }
}
#==============================================================================================================================================
# IS_IN
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# find value in an array
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : array ref
#  1 : value to find
# OUTPUT PARAMETERS
#  0 : index of the found value in the array, otherwise -1
#==============================================================================================================================================
sub is_in
{
	 my @a = @{$_[0]};
	 my $id = $_[1];
	 my $k;

	 
	 my $found = -1;
	 
	 for ($k=0; $k<=$#a; $k++) 
	 {
	     if ($a[$k] eq $id) {$found=$k;last;}
	 }
		
	 return $found;
}


#==============================================================================================================================================
# GET_OBJ_HASH_FROM_DB
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# find any tuple (hash) from any table given the primary key
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : connection handle
#  1 : SQL table
#  2 : primary key (id)
# OUTPUT PARAMETERS
#  0 : hash ref to the tuple
#==============================================================================================================================================
sub get_obj_hash_from_db
{
	 my $dbh = $_[0] || 0;
	 my $table = $_[1] || "";
	 my $id = $_[2] || 0;
	 my %obj;
	 
	 my ($stmt,$cursor,$rc);
	 $stmt = "SELECT * FROM $table where id = $id";

	 if ($id !~ /^\d*$/) {suicide("ERROR in ID not NUMERIC : [$stmt]");}
	 
	 $cursor = $dbh->prepare($stmt);
	 $rc = $cursor->execute || suicide("SQL ERROR : $DBI::errstr [$stmt]");
	 %obj = %{$cursor->fetchrow_hashref};
	 $cursor->finish; 

	 return \%obj; 
}

#==============================================================================================================================================
# GET_SCRIPT
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# get script name from url
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : url to analyze
# OUTPUT PARAMETERS
#  0 : string containing the script's name
#==============================================================================================================================================
sub get_script
{
	 my $url = $_[0];

	 my @t1 = split(/\?/,$url);
	 my @t2 = split (/\//,$t1[0]);
	 
	 return $t2[$#t2];
}

#==============================================================================================================================================
# GET_HIDDEN_PARAMS
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# transform url parameters into hidden params for form excepted certain values
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : url to analyze
#  1 : exception list (comma separated values)
# OUTPUT PARAMETERS
#  0 : string containing <hidden> fields
#==============================================================================================================================================
sub get_hidden_params
{
	 my $url = $_[0];
	 my $except = $_[1];
	 
	 my @t1 = split(/\?/,$url);
	 my @t2 = split (/&/,$t1[1]);
	 my @texc = split (/,/,$except);

	 my ($pair,$key,$value,$hidden,$put);
	 
	 foreach $pair (@t2)
	 {
		   ($key,$value) = split(/=/,$pair);
		   foreach $except (@texc)
		   {
				if ($key eq $except) {$put = 0; last;}
				else {$put = 1;}
		   }
		   if ($put) {$hidden.="<input type=\"hidden\" name=\"$key\" value=\"$value\"/>";}
	 } 
	  
	 return $hidden; 
}

#==============================================================================================================================================
# GET_USER_INFO
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# get global config for the current user
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : connection handle
#  1 : user ID
# OUTPUT PARAMETERS
#  0 : hash ref to user
#==============================================================================================================================================
sub get_user_info
{
 my $dbh=$_[0];
 my $user = $_[1] || 0;

 return undef if ($user < 1);
 
 my %user = ();
 
 my $stmt = "SELECT identity, email, id_role, id_tree_home 
             FROM users 
            WHERE id = $user";

 my $cursor = $dbh->prepare($stmt);
 $cursor->execute || wfw_exception("SQL_ERROR","error execute : $DBI::errstr [$stmt]\n");


 my ($identity,$email,$role,$home) = $cursor->fetchrow_array;
 $cursor->finish;
 
 $user{id} = $user;
 $user{identity} = $identity;
 $user{email} = $email;
 $user{role} = $role;
 $user{home} = $home;
 $user{ispro} = ($user{role}<3);
 
 return (\%user);
}


#==============================================================================================================================================
# PDF_TEXT
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# print text in the given PDF handle
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : PDF handle
#  1 : text
#  2 : font
#  3 : font size
#  4 : x position (0,0 is bottom left) 
#  5 : y position (0,0 is bottom left) 
#  6 : color
#  7 : align (0=left,1=center,2=right)
# OUTPUT PARAMETERS
#  none
#==============================================================================================================================================
sub pdf_text
{
 my $pdf_h = $_[0];
 my $txt = $_[1];
 
 $txt = decode("utf8",$txt);
 
 my $font = $_[2];
 my $fontsize = $_[3];
 my $x = $_[4];
 my $y = $_[5];
 my $color = $_[6];
 my $align = $_[7];
 
 if ($align) { 
     my $w = $pdf_h->getFontWidth($txt,$font,$fontsize);
     if ($align == 1) {
         $decay = int ($w/2);
     } elsif ($align == 2) {
         $decay = $w;
     }
  $x -= $decay;
 } 

 $pdf_h->drawText($txt,$font,$fontsize,$x,$y,$color);
 
}

sub trim
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}
# Left trim function to remove leading whitespace
sub ltrim
{
	my $string = shift;
	$string =~ s/^\s+//;
	return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim
{
	my $string = shift;
	$string =~ s/\s+$//;
	return $string;
}

###############################################################################
# MAKE_XHTML
###############################################################################

sub make_xhtml
{
 my $str = $_[0];
 #return $str;
 
 $str =~ s/<STRONG>/<strong>/g;
 $str =~ s/<\/STRONG>/<\/strong>/g;
 $str =~ s/<B>/<strong>/g;
 $str =~ s/<\/B>/<\/strong>/g;
 $str =~ s/<EM>/<em>/g;
 $str =~ s/<\/EM>/<\/em>/g;
 $str =~ s/<I>/<em>/g;
 $str =~ s/<\/I>/<\/em>/g;
 $str =~ s/<UL>/<ul>/g;
 $str =~ s/<\/UL>/<\/ul>/g;
 $str =~ s/<OL>/<ol>/g;
 $str =~ s/<\/OL>/<\/ol>/g;
 $str =~ s/<LI>/<li>/g;
 $str =~ s/<\/LI>/<\/li>/g;
 $str =~ s/<P>/<p>/g;
 $str =~ s/<P align=right>/<p style="text-align:right;">/g;
 $str =~ s/<P align=center>/<p style="text-align:center;">/g;
 $str =~ s/<\/P>/<\/p>/g;
 $str =~ s/<BR>/<br \/>/g;
 $str =~ s/<U>/<u>/g;
 $str =~ s/<\/U>/<\/u>/g;

 if ($str =~ /PRIVATE/) {
 
 $str =~ s/href=\"\[(.*?)\]\">/href=\"cgi-bin\/wrapper.pl\?f\=$1\"}/g;
 
 }
 return $str;
}

sub unmake_xhtml
{
 my $str = $_[0];
 #return $str;
 
 $str =~ s/<STRONG>/<b>/g;
 $str =~ s/<\/STRONG>/<\/b>/g;
 $str =~ s/<strong>/<b>/g;
 $str =~ s/<\/strong>/<\/b>/g;
 $str =~ s/<EM>/<i>/g;
 $str =~ s/<\/EM>/<\/i>/g;
 $str =~ s/<em>/<i>/g;
 $str =~ s/<\/em>/<\/i>/g;
 
 
 $str =~ s/<p \/>/<br \/><br \/>/g;
 
 $str=~ s/\r*\n//g;
# $str =~ s/?eacute;/g;
# $str =~ s/?egrave;/g;
# $str =~ s/?agrave;/g;
# $str =~ s/?\#281;/g;
# $str =~ s//&ocirc;/g;
# $str =~ s/?icirc;/g;
# $str =~ s/?acirc;/g;
# $str =~ s//&\#367;/g;

 return $str;
}

sub clean_url
{
  my $url = $_[0];
  my $allow_slashes = $_[1] || "n";
  
  $url = trim ($url);
  if ($allow_slashes ne "y") { $url =~ s/\//-/g; }
  $url =~ s/\@/a/g;
  $url =~ s/\€/eur/g;
  $url =~ s/\#//g;
  $url =~ s/\.//g;
  $url =~ s/\™//g;
  
  $url = lc(clean_filename($url,'n',$allow_slashes));
  
  return $url;

}

sub clean_filename
{
 my $filename = $_[0];
 my $cut = $_[1] || 'y';
 my $allow_slashes = $_[2] || "n";
 
 if ($allow_slashes ne "y") {
     my @filepath = split(/[\/|\\]/,$filename);
     $filename = $filepath[$#filepath]; 
 }

 
 
 $filename =~ s/\'//g;
 $filename =~ s/\,//g;
 $filename =~ s/\"//g;
 $filename =~ s/\?//g;
 $filename =~ s/\(//g;
 $filename =~ s/\)//g;
# $filename =~ s/\.//g;
 $filename =~ s/\;//g;
 $filename =~ s/\&//g;
 $filename =~ s/\+//g;
 $filename =~ s/\s+/-/g;
 
 $filename = remove_accents_from($filename);

 $filename =~ s/%/-/g;
 if($cut eq 'y')
 {
    $filename = substr($filename,0,75);
 }
 return $filename;
}




################################################################################
# GET_TEXTCONTENT
################################################################################
sub get_textcontent
{
 my $dbh = $_[0];
 my $textid = $_[1];
 my $id_language = $_[2] || $config{current_language} || 1;
 my $txt_src = $_[3];
#  print "get_textcontent: $textid ,$id_language";
 
 if (!defined $textid || !$textid || !($textid > 0)) {return ("",1);}
 
 ###############################################################################
 #=============================================================================#
 ###############################################################################

 my $table_txt_src = 'textcontents';
 if($config{version_num} >= 4000)
 {    
    $table_txt_src = 'txtcontents';
    if($txt_src ne '')
    {
        $table_txt_src = $txt_src.'_'.$table_txt_src;
    }
 }


 if ($use_global_textcontents) 
 {
 
     if ($global_textcontents_loaded) 
     {
         return ($GLOBAL_TEXTCONTENTS{$id_language}{$textid},0);
     } 
     else 
     {
         my @lglist = get_languages_ids($dbh);
         foreach my $l (@lglist) 
         {
             my @txt = ();
             if($config{version_num} >= 4000)
             {    
                #A OPTIMISER car tout est maintenant sur une ligne.
                @txt = sql_lines({dbh=>$dbh,table=>$table_txt_src,select=>"id as id_textid, lg$l as content",where=>""});
             }
             else
             {
               @txt = get_table($dbh,$table_txt_src,"id_textid,content","id_language=$l");
             }
             my $empty = 0;
             foreach my $t (@txt) 
             {
                  $GLOBAL_TEXTCONTENTS{$l}{$t->{id_textid}} = $t->{content};
             }                  
         }     
         $global_textcontents_loaded = 1;
         return ($GLOBAL_TEXTCONTENTS{$id_language}{$textid},0);
     }
  }


 ###############################################################################
 #=============================================================================#
 ###############################################################################
 
 if($config{version_num} >= 4000)
 { 
       my %txt = sql_lines({dbh=>$dbh,table=>$table_txt_src,select=>"id, lg$id_language as content",where=>"id=$textid"});
       my $empty = 0;
       if($txt{id} > 0) { $empty = 1; }
       return ($txt{content},$empty); 
 }
 else
 {
       my $stmt = "SELECT content FROM textcontents WHERE id_textid = '$textid' AND id_language = '$id_language'";
      
      if (! defined $dbh) { suicide("SQL ERROR : $stmt : $!"); }
       my $cursor = $dbh->prepare($stmt) || suicide("SQL ERROR : $stmt : $!");
       my $rc = $cursor->execute;
       if (!defined $rc) {suicide($stmt);}
       
       my $empty = 0;
       
       my ($content) = $cursor->fetchrow_array;
       if (!defined $content) {$empty=1;}
       $cursor->finish;

      return ($content,$empty);
 }
}


#*******************************************************************************
#SELECT TABLE
#*****************************************************************************
sub select_table
{
  my $dbh_dbf        = $_[0];
  my $table          = $_[1];
  my $selector       = $_[2] || '*';
  my $where          = $_[3];
  my $order          = $_[4];
  my $limit          = $_[5];
  my $debug          = $_[6] || 0;
  my %ligne;
  my $where_cond="";
  
  
  $where =~ s/\s+union\s*//ig;
  
  if($where ne "")
  {
      $where_cond="where $where";
  }
  
  if($order ne "")
  {
      $order="order by $order";
  }
  
  if($limit ne "")
  {
      $limit="limit $limit";
  }
  
	my $stmt = "select $selector FROM $table $where_cond $order $limit";
	
	if($debug == 1)
	{
     see();
     print "<br /><br />(( $stmt ))";
  }
  
  my $cursor = $dbh_dbf->prepare($stmt);
	$cursor->execute || suicide($stmt);
	
# 	if (!defined $rc) 
# 	{
# # 		  see();
# # 		  print join('/',caller)."[$stmt]";
# # 	    exit;
#         suicide($stmt);   
# 	}

# 	 while ($ref_rec = $cursor->fetchrow_hashref()) 
# 	 {
# 	    %ligne = %{$ref_rec};
# 	 }
   my %ligne = %{$cursor->fetchrow_hashref()}; 

   $cursor->finish; 
   
	 return %ligne;
}

sub sql_get_row_from_params;
*sql_get_row_from_params = \&select_table;


#-------------------------------------------------------------------------------
# GET_LISTBOX_FROM_TABLE
#-------------------------------------------------------------------------------
sub get_listbox_from_table
{
 my $dbh = $_[0]; 
 my $table = $_[1]; 
 my $key = $_[2]; 
 my $display = $_[3]; 
 my $where = $_[4]; 

 %hlb = ();
 if ($where ne "") {$where = "WHERE ".$where};
 
 my ($stmt,$cursor,$rc);
 
 $stmt = "select DISTINCT $key,$display FROM $table $where";
 $cursor = $dbh->prepare($stmt);
 $rc = $cursor->execute;
 if (!defined $rc) {die("error execute : $DBI::errstr [$stmt]\n");}

  my ($name,$value);
 
  $cursor->bind_columns(\$id,\$value);
  while ($cursor->fetch())
       {
  	    $hlb{$id} = $value; 
       }
      $cursor->finish;

 #$hlb{0} = "";
 return (\%hlb);
}


sub encode_html
{
    my $str=$_[0];
   
#    see();
   
#    print "<br />chaine avant: $str";
    
    $str =~ s/Ú/&eacute;/g;
    $str =~ s/Û/&ecirc;/g;
    $str =~ s/Þ/&egrave;/g;
    $str =~ s/Ó/&agrave;/g;
    $str =~ s/´/&iuml;/g;
    
#     print "<br />chaine apres: $str";
#       exit;
    return $str;
}

#*******************************************************************************
#GET TABLE HASH
#*******************************************************************************
sub get_table_hash
{
  my %hash=();
  my $dbh_dbf     = $_[0];
  my $table_name=$_[1];
  my $selector=$_[2] || "*";
 
  my $where=$_[3] || "1";
  if($where ne "")  {     $where="where $where";       }
  my $ordby=$_[4] || "";
  if($ordby ne "")  {     $ordby="order by $ordby";       }
  
  my $key=$_[5];
  my $value1=$_[6];
  my $value2=$_[7];
  my $value3=$_[8];
 

  my $stmt = "SELECT $selector FROM $table_name $where $ordby ";
 	#see();
  #print "<br /><br />".$stmt;
  #exit;
	
  my $cursor = $dbh_dbf->prepare($stmt);
	my $rc = $cursor->execute;
  my $type_badge,$url_pdf="";;
	if (!defined $rc) 
	{
	  see();
	  print "[$stmt]";
	  exit;   
	}	
	
	while ($ref_rec = $cursor->fetchrow_hashref()) 
	{
	   my %rec = %{$ref_rec};
     
     $hash{$rec{$key}}=$rec{$value1};
     #print $rec{$key};
     #print $rec{$value1};
     #print "<br />".$rec{id};
     
     if($value2 ne "")
     {
        $hash{$rec{$key}}.="_".$rec{$value2};
     } 
     if($value3 ne "")
     {
        $hash{$rec{$key}}.="_".$rec{$value3};
     }
         
  } 
  return %hash;
}

sub ajax_get_var
{
  my $table=get_quoted('table');
  my $var=get_quoted('var1') || get_quoted('var');
  my $var2=get_quoted('var2');
  my $id=get_quoted('id');
  
  $id=int($id);  
  my %hash=read_table($table,$id);
  
  
  if($var2 eq "") {         print($hash{$var});                   }
  else            {         print($hash{$var}." ".$hash{$var2});  }
  exit;
}


sub insert_table
{
 my $dbh_dbf     = $_[0];
 my $table = $_[1];
 my %row = %{$_[2]};
 my @columns = keys(%row);
 my ($cols,$vals,$stmt,$rc);

 foreach $v (@columns)
  {
   $cols.="$v,";
   $vals.="'$row{$v}',";
  }
 chop($cols);
 chop($vals);

 $stmt = "INSERT into $table ($cols) VALUES ($vals)";
 $stmt =~ s/\'CURRENT_DATE\'/CURRENT_DATE/g;
 $stmt =~ s/\'NOW\(\)\'/NOW\(\)/g;
 #see();
 #print $stmt;
 #exit;
 
 $rc = $dbh_dbf->do($stmt) || die "cant execute function do";
 return $dbh_dbf->{mysql_insertid};
}

sub update_table
{
 my $dbh_dbf     = $_[0];
 my $table = $_[1];
 my %row = %{$_[2]};
 my $where          = $_[3];
 my $where_cond="";
  
  if($where ne "" )
  {
      $where="where $where";
  }

 my @columns = keys(%row);
 my ($upd,$stmt,$rc);

 foreach $v (@columns)
 {
   $upd.="$v = '$row{$v}',";
 }
 chop($upd);

 $stmt = "UPDATE $table SET $upd $where";
 $stmt =~ s/\'CURRENT_DATE\'/CURRENT_DATE/g;
 $stmt =~ s/\'NOW\(\)\'/NOW\(\)/g;
 
# log_to($stmt);
 $rc = $dbh_dbf->do($stmt);
 if (!defined $rc) {
 
see();
        print "[$stmt]";
        exit; 
 
 }
}

sub truncate_table
{
    my $dbh_dbf     = $_[0];
    my $table=$_[1];
    my $stmt = "TRUNCATE TABLE `$table` ";
    my $cursor = $dbh_dbf->prepare($stmt);
    my $rc = $cursor->execute;
    if (!defined $rc) 
    {
        see();
        print "[$stmt]";
        exit;   
    }
}

                
sub dumper
{
  my %hash=%{$_[0]};
  see();
  print "<br /><br />{<pre>".Dumper(\%hash)."</pre>}<br /><br />";
}
sub see_array
{
  my @array=@{$_[0]};
  see();
  print "<br /><br />{<pre>".Dumper(\@array)."</pre>}<br /><br />";
}



sub split_datetime
{
    my $date_time=$_[0];
    my ($date1,$time1) = split(/ /,$date_time);
    my ($year1,$month1,$day1) = split(/-/,$date1);
    return ($day1,$month1,$year1);
}

sub split_date
{
    my $date_time=$_[0];
    my ($date1,$time1) = split(/ /,$date_time);
    my ($year1,$month1,$day1) = split(/\-/,$date1);
    return ($day1,$month1,$year1);
}

sub split_time
{
    my $date_time=$_[0];
    my ($date1,$time1) = split(/ /,$date_time);
    my ($heures,$minutes,$secondes) = split(/\:/,$time1);
    return ($heures,$minutes,$secondes);
}

sub get_hash_from_config
{
 my $dbh_dbf = $_[0];
 my $param = $_[1];
# my $stmt = "select varvalue FROM config where varname='$param'";
 

# my $cursor = $dbh_dbf->prepare($stmt);
# $cursor->execute || die("error execute : $DBI::errstr [$stmt]\n");
# my $hash = $cursor->fetchrow_array();
# $cursor->finish;

$hash = $config{$param};

$hash =~ s/<APOSTROPHE>/\\\'/g;




my %hash = eval ("%hash = ($hash)");  die "$@ ($param)" if $@;
#  exit;
 return %hash;
}


#==============================================================================================================================================
# GET QUOTED DEUTF8
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# get a CGI param already "quoted" for use in SQL statements 
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : CGI parameter name
# OUTPUT PARAMETERS
#  0 : value of the parameter, with ' quoted
#==============================================================================================================================================
sub get_quoted_deutf8
{
	my $var = $_[0];	#RÚcupÚration de la variable
	my $val = get_quoted($var,"utf8");	#Copie de la valeur du paramÞtre citÚ
	
	return $val;	#Retourne la valeur du paramÞtre citÚ
}


#==============================================================================================================================================
# GET PARAM DEUTF8
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# get a CGI param already "quoted" for use in SQL statements 
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : CGI parameter name
# OUTPUT PARAMETERS
#  0 : value of the parameter, with ' quoted
#==============================================================================================================================================
sub get_param_deutf8
{
	my $var = $_[0];	#RÚcupÚration de la variable
	my $val = $cgi->param($var);	#Copie de la valeur du paramÞtre citÚ
	use Encode;
	$val = decode("utf8",$val);

	$val = sanitize_input($val);
	
#	$val =~ s/\'/\\\'/g;	#Traitement de la valeur
#	$val =~ s/\Æ/\\\'/g;
	
	return $val;	#Retourne la valeur du paramÞtre citÚ
}


#-------------------------------------------------------------------------------
# CREATE_TOKEN
#-------------------------------------------------------------------------------

sub create_token
{
	my $length_of_randomstring= $_[0];
  my $whatchars= $_[1] || 'aA0';
  my @chars = (); 
  if($whatchars eq 'aA0')
  {
	   @chars=('a'..'z','A'..'Z','0'..'9');
  }
  elsif($whatchars eq 'a0')
  {
	   @chars=('a'..'z','0'..'9');
  }
  elsif($whatchars eq 'a')
  {
	   @chars=('a'..'z');
  }
  elsif($whatchars eq 'numbers')
  {
	   @chars=('0'..'9');
  }
	my $random_string;
	foreach (1..$length_of_randomstring) 
	{
		# rand @chars will generate a random 
		# number between 0 and scalar @chars
		$random_string.=$chars[rand @chars];
	}
	return $random_string;
}



###############################################################################
# GET_SHOPCATTYPES
###############################################################################
sub get_shopcattypes
{
 my $dbh=$_[0];
 my $shop = $_[1];
 my $type = $_[2];
 my $obj = $_[3];
 my $name = $_[4];
 my $table= $_[5] || "product_crit_listvalues";
 my $where=$_[6] || "id_product_crit";
 my $table_lnk_sheets_listvalues= $_[7] || "lnk_sheets_listvalues";
 my $id_sheet=$_[8] || "id_product_sheet"; 
 
 
 my ($id,$id_name);
 
  
 
 my $stmt = "SELECT id,id_textid_name FROM $table where $where='$type' ORDER BY ordby";
# print "$stmt<br>";
 my $cursor = $dbh->prepare($stmt);
 my $rc = $cursor->execute;
 if (!defined $rc) {suicide($stmt);}

 my $cpt=0;
 my $list = "";
 while (($id,$id_name) = $cursor->fetchrow_array)
  {
   my ($name,$dum) = get_textcontent($dbh,$id_name);
	 my $checked=""; my $debug = "";
	 if (is_shopobj_linked($dbh,$id,$obj,$table_lnk_sheets_listvalues,$id_sheet))
	     {
        $checked = "checked=\"checked\"";			 
        $debug = "cochéš";
			 }
   $list.="<li><input type=checkbox name=\"$type"."_$cpt\" id=\"$type"."_$cpt\" VALUE=\"$id\" $checked /><label for=\"$type"."_$cpt\">$name</label></li> ";
	 $cpt++;
  }
   $list.="<input type=hidden name=\"cpt_$type\" VALUE=\"$cpt\" />";
 $cursor->finish;

 return $list;
}

###############################################################################
# GET_SHOPCATTYPES
###############################################################################

sub get_shopcattypes_display
{
 my $dbh=$_[0];
 my $type = $_[1];
 my $obj = $_[2];
 my $name = $_[3];
 my $table= $_[4] || "product_crit_listvalues";
 my $where=$_[5] || "id_product_crit";
 my $table_lnk_sheets_listvalues= $_[6] || "lnk_sheets_listvalues";
 my $id_sheet=$_[7] || "id_product_sheet"; 
 
 
 my ($id,$id_name);
 my %products_cfg =get_hash_from_config($dbh,'products_cfg');
 my $tpl_display_cl=migcrender::get_template($dbh,$products_cfg{product_crits_display_line});

 
 my $stmt = "SELECT id,id_textid_name FROM $table where $where='$type' ORDER BY ordby";
# print "$stmt<br>";
 my $cursor = $dbh->prepare($stmt);
 my $rc = $cursor->execute;
 if (!defined $rc) {suicide($stmt);}

 my $cpt=0;
 my $list = "";
 ###############################################################################
 #=============================================================================#
 ###############################################################################

 if ($table_lnk_sheets_listvalues eq "lnk_sheets_listvalues") {
 
     unless (keys %shop_lvls_assoc) {
         %shop_lvls_assoc = shop_lvls_assoc($dbh);
     }  
 }
 ###############################################################################
 #=============================================================================#
 ###############################################################################

 while (($id,$id_name) = $cursor->fetchrow_array)
 {
   my ($name,$dum) = get_textcontent($dbh,$id_name);
	 my $checked=""; 
	 
   if (is_shopobj_linked($dbh,$id,$obj,$table_lnk_sheets_listvalues,$id_sheet))
	 {
      $tpl_display_cl=migcrender::get_template($dbh,$products_cfg{product_crits_display_line});
      $tpl_display_cl=~ s/<MIGC_PRODUCTS_CRIT_NAME_HERE>/$name/;
      $list.=$tpl_display_cl; 
	 }
	 $cpt++;
 }
 $cursor->finish;

 return $list;
}

###############################################################################
# IS_SHOPOBJ_LINKED
###############################################################################

sub is_shopobj_linked
{
 my $dbh=$_[0];
 my $type = $_[1];
 my $prod = $_[2];
 my $table = $_[3] || "lnk_sheets_listvalues";
 my $where = $_[4] || "id_product_sheet";


 ###############################################################################
 #=============================================================================#
 ###############################################################################
  if (keys %shop_lvls_assoc) {  
      return is_in($shop_lvls_assoc{$type},$prod);      
  } 
 ###############################################################################
 #=============================================================================#
 ###############################################################################

 my ($stmt,$cursor,$rc);
 
 $stmt = "SELECT id FROM $table where id_crit_listvalue='$type' AND  $where= '$prod'";
 #print "$stmt";
 $cursor = $dbh->prepare($stmt);
 $rc = $cursor->execute;
 if (!defined $rc) {die("error execute : $DBI::errstr [$stmt]\n");}
 my $nbres = $cursor->rows();
 return ($nbres);
}

sub shop_lvls_assoc 
{
 my $dbh = $_[0];
 my %shop_lvls_assoc = ();
 
 my @lnks = get_table($dbh,"lnk_sheets_listvalues","id_crit_listvalue,id_product_sheet");
 
 foreach $lnk (@crits) 
 {
  push (@{$shop_lvls_assoc{$lnk->{id_crit_listvalue}}},$lnk->{id_product_sheet});
 }
 	
 return %shop_lvls_assoc;
}



sub remove_param_from_url
{
 my $url = $_[0];
 my $param = $_[1];
 
 my @newparts = ();
 my @parts = split(/&/,$url);
 foreach $part (@parts) {
  if ($part !~ /^$param/) {
      push @newparts, $part;
  }
 }
 
 return join("&",@newparts);
}

#*******************************************************************************
#GET DESCRIBE
#*****************************************************************************
sub get_describe
{
    my $dbh_dbf     = $_[0];
    my $table_name=$_[1];
    my @table =();
  	my $stmt = "DESCRIBE $table_name";
  	if($debug)
  	{
        see();
   	    print "<br /><br />".$stmt."<br /><br />";
   	}
  	my $cursor = $dbh_dbf->prepare($stmt);
  	my $rc = $cursor->execute;
  	if (!defined $rc) 
  	{
  		  see();
  		  print "[$stmt]";
  	    exit;   
  	}
  	 while ($ref_rec = $cursor->fetchrow_hashref()) 
  	 {
  	    my %rec = %{$ref_rec};
  		  push @table,\%{$ref_rec};
  	 }
  	 $cursor->finish;
  	 return @table;
}


sub sanitize_input
{
 my $val = $_[0];
 
  $val =~ s/\a*//g;	#Traitement de la valeur
	$val =~ s/\e*//g;	#Traitement de la valeur
	$val =~ s/\x00*//g;	#Traitement de la valeur
	$val =~ s/\x0d*//g;	#Traitement de la valeur
	$val =~ s/\x04*//g;	#Traitement de la valeur
  
# 	$val =~ s/--//g;	#Traitement de la valeur
#	$val =~ s/\|//g;	#Traitement de la valeur
	$val =~ s/\/etc\/passwd//g;	#Traitement de la valeur
	$val =~ s/\/tmp//g;	#Traitement de la valeur
	$val =~ s/%00//g;	#Traitement de la valeur
	$val =~ s/%04//g;	#Traitement de la valeur
	$val =~ s/%0d//g;	#Traitement de la valeur
#	$val =~ s/\.\.\///g;	#Traitement de la valeur
	$val =~ s/1=1//g;	#Traitement de la valeur
	$val =~ s/\/\*//g;	#Traitement de la valeur
	$val =~ s/\*\///g;	#Traitement de la valeur
	$val =~ s/null\,//ig;	#Traitement de la valeur
	$val =~ s/select\s+//ig;	#Traitement de la valeur
	$val =~ s/delete\s+//ig;	#Traitement de la valeur
	$val =~ s/update\s+//ig;	#Traitement de la valeur
#	$val =~ s/select\(//ig;	#Traitement de la valeur
	$val =~ s/\(select//ig;	#Traitement de la valeur

#	$val =~ s/union\s+//ig;	#Traitement de la valeur
#	$val =~ s/\s+union//ig;	#Traitement de la valeur
	$val =~ s/describe\s+//ig;	#Traitement de la valeur
	
 return $val;
}

sub str_replace {
	my $replace_this = shift;
	my $with_this  = shift; 
	my $string   = shift;
	
	my $length = length($string);
	my $target = length($replace_this);
	
	for(my $i=0; $i<$length - $target + 1; $i++) {
		if(substr($string,$i,$target) eq $replace_this) {
			$string = substr($string,0,$i) . $with_this . substr($string,$i+$target);
			return $string; #Comment this if you what a global replace
		}
	}
	return $string;
}
#==============================================================================================================================================
# CGI_REDIRECT
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# redirect to a given url
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : url to redirect to
# OUTPUT PARAMETERS
#  none
#==============================================================================================================================================
sub cgi_redirect
{
    my $url = $_[0];	#url de redirection
    print $cgi->redirect(-uri=>$url,-status=>'303 See Other');
    exit;
}

#==============================================================================================================================================
# AJAX_REDIRECT
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# redirect to a given url in a div
#--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
# INPUT PARAMETERS 
#  0 : url to redirect to
#  1 : id to redirect in
# OUTPUT PARAMETERS
#  none
#==============================================================================================================================================

sub ajax_redirect 
{
 my $url = $_[0];
 my $div_id = $_[1];
 
 print <<"EOH";
<script type="text/javascript" src="mig_skin/js/jquery-1.6.2.min.js"></script>
		<script type="text/javascript" src="mig_skin/js/ajaxfileupload.js"></script>
		<script type="text/javascript" src="mig_skin/js/tiny_mce/tiny_mce_popup.js"></script>

<script type="text/javascript">
\$(document).ready(function() {

//alert('[$url] in [$div_id]');

\$("#$div_id").load('$url');
});
</script>

EOH


exit;
}

sub get_next_ordby
{
    my %params = @_;
    
    my $where = $params{where} || 1;
    my %next = select_table($params{dbh},$params{table},'ordby',$where.' order by ordby desc');
    
    return $next{ordby} + 1;
}


################################################################################
# GET_LANGUAGES_IDS
################################################################################

sub get_languages_ids
{
 my $dbh = $_[0];
 my $stmt = "SELECT id FROM languages where visible = 'y' ORDER BY id";
 my $cursor = $dbh->prepare($stmt);
 my $rc = $cursor->execute;
 if (!defined $rc) {suicide($stmt);}

 my @idarray = ();
 while (($id) = $cursor->fetchrow_array)
  {
    if($id > 0)
    {
        push (@idarray,$id);
    }
  }
 $cursor->finish;

 return (@idarray);
}

sub write_file
{
 my $filename = $_[0] || "";
 my $content = $_[1] || "";
 

 open (FILE,">>$filename") || suicide("cannot open $filename : $!");
 print FILE $content;
 close FILE;
}

sub reset_file
{
 my $filename = $_[0] || "";
 
 open (FILE,">$filename") || die "cannot create $filename : $!";
 close FILE;
}

sub write_htaccess
{
 my $content = $_[0];
 my $htaccess = $config{htaccess_tmp};
 
 write_file($htaccess,$content);
 
}

sub write_sitemap
{
 my $content = $_[0];
 my $xmlsitemap = $config{sitemap_tmp};

 write_file($xmlsitemap,$content);
}
sub create_manifest
{
 my $cfg_file = $config{root_path}."/skin/manifest.txt";
 my $manifest = $config{root_path}."/site.manifest";
 
 open (IN,$cfg_file) || ajax_die("cannot read $cfg_file : $!");
 open (OUT,">$manifest") || ajax_die("cannot write $manifest : $!");
 
print OUT <<"EOF";
CACHE MANIFEST

CACHE:
EOF
 
 while (<IN>) {
     my $path = $_;
     $path =~ s/\r*\n//g;
     
  
     next if ($path eq "");
     
     my @files = get_manifest_recurse_filenames($config{root_path},$path);
     
#     print Dumper(@files);
     
     foreach my $file (@files) {
         print OUT $file."\n";
     }
 }
  
 close OUT;
 close IN;
}

sub get_manifest_recurse_filenames
{
 my $root = $_[0];
 my $currdir = $_[1];
 
 my @files = ();
 
 my $fulldir = $root."/".$currdir;

 opendir(my $dh, $fulldir) || ajax_die("cannot open dir $fulldir : $!");
 my @file_list = readdir($dh);
 closedir $dh;

 foreach my $f (@file_list) { 
    if ($f ne "." && $f ne "..") {
        if (-d $fulldir."/".$f) {
            my @rec_files = get_manifest_recurse_filenames($root,$currdir."/".$f);
#            print Dumper(@rec_files); 
            push @files, @rec_files;
            
        } elsif (-f $fulldir."/".$f) {
            push @files, $currdir."/".$f;        
        }
    }
 }

 return @files; 
}


sub ajax_die
{
 my $msg = $_[0];
 
 print "ERROR : ".$msg;
 exit;
}


#*******************************************************************************
#SQL_LINES
#*******************************************************************************
sub sql_line
{
    my %d = %{$_[0]};
    $d{one_line} = 'y';
    return sql_lines(\%d);
}




#*******************************************************************************
#SQL_LINES
#*******************************************************************************
sub sql_lines
{
    my %d = %{$_[0]};
    my $dbh_line = $dbh;
    $d{where} = trim($d{where});
    
    $d{where} =~ s/^WHERE//g;
    $d{where} =~ s/^where//g;
    if($d{where} eq "")    {    $d{where} = " 1 ";         }
    if($d{where} ne "")    {    $d{where} = "WHERE $d{where} ";         }
    
    $d{ordby} =~ s/ORDER BY//g;
    $d{ordby} =~ s/order by//g;
    if($d{ordby} ne "")    {    $d{ordby} = "ORDER BY $d{ordby} ";      }
    
    $d{groupby} =~ s/GROUP BY//g;
    $d{groupby} =~ s/group by//g;
    if($d{groupby} ne "")  {    $d{groupby} = "GROUP BY $d{groupby} ";    }
    
    $d{limit} =~ s/LIMIT//g;
    $d{limit} =~ s/limit//g;
    if($d{limit} ne "")    {    $d{limit} = "LIMIT $d{limit} ";         }
    
    if($d{select} eq "")   {    $d{select} = "*";                       }
    if($d{dbh} ne '')      {    $dbh_line = $d{dbh};                         } 
    
    if($d{table} eq '' || $d{select} eq '' || $d{where} eq '')
    {
        see();
        print "MISSING PARAMS: table[$d{table}]select[$d{select}]where[$d{where}]";
        exit;
    }
    
    my @table =();
  	my $stmt = "SELECT $d{select} FROM $d{table} $d{where} $d{groupby} $d{ordby} $d{limit}";        
  	if($d{debug})        	 {    see(); print "<br /><b>[$stmt]</b>";          	}
   	
  	my $cursor = $dbh_line->prepare($stmt) || die("CANNOT PREPARE $stmt");
  	$cursor->execute || suicide($stmt);
  	
    if($d{one_line} eq 'y')
    {
        my %ligne = %{$cursor->fetchrow_hashref()};
        $cursor->finish;
        if($d{debug_results})        	 {    see(\%ligne);        	}
        return %ligne;
    } 
    
    while ($ref_rec = $cursor->fetchrow_hashref()) 
  	{
   		  push @table,\%{$ref_rec};
        if($d{debug_results})        	 {    see($ref_rec);        	}
  	}
  	$cursor->finish;
  	return @table;
}


#*****************************************************************************************
sub sql_radios
{
    my %d = %{$_[0]};
        
    if($d{table} ne "" && $d{value} ne "" && $d{display} ne "" && $d{name} ne "")
    {
          my $cbs=<<"EOH";
EOH
          my @records=get_table($d{dbh},$d{table},$d{select},$d{where},$d{ordby},"","",$d{debug});
          foreach my $rec (@records)
          {
              my $checked="";
              if($d{current_value} eq $rec->{$d{value}})
              {
                  $checked=<<"EOH";
                   checked = "checked"                
EOH
              }
              $cbs.=<<"EOH";
                <label>   
                  <input type="radio" name="$d{name}" $checked value="$rec->{$d{value}}" $d{required} class="$d{class}"> 
                  $rec->{$d{display}}
                </label>
EOH
          }    
          
          $cbs.=<<"EOH";
EOH
          return $cbs;
          exit;
    }
    else
    {
        return "missing mandatory data: [table:$d{table}][value:$d{value}][display:$d{display}][name:$d{name}]";
    }  
}
#*****************************************************************************************
sub sql_listbox
{
    my %d = %{$_[0]};

    my $empty_option=<<"EOH";
      <option value="">$d{empty_txt}</option>
EOH
    if($d{show_empty} ne 'y')
    {
        $empty_option="";
    }
    
    if($d{table} ne "" && $d{value} ne "" && $d{display} ne "" && $d{name} ne "")
    {
          my $listbox=<<"EOH";
              <select name="$d{name}" $d{required} id="$d{id}" class="$d{class}">
                  $empty_option             
EOH
         
          my @records=get_table($d{dbh},$d{table},$d{select},$d{where},$d{ordby},"","",$d{debug});
          
          foreach my $rec (@records)
          {
              my $selected="";
              if($d{current_value} eq $rec->{$d{value}})
              {
                  $selected=<<"EOH";
                   selected = "selected"                
EOH
              }
              if($d{translate} eq 'y')
              {
                  ($rec->{$d{display}},$dum) = get_textcontent($dbh,$rec->{$d{display}},$d{lg});
              }
              $listbox.=<<"EOH";
                  <option value="$rec->{$d{value}}" $selected>
                    $rec->{$d{display}}
                  </option>
EOH
          }    
          
          $listbox.=<<"EOH";
              </select>       
EOH
          return $listbox;
          exit;
    }
    else
    {
        return "missing mandatory data: [table:$d{table}][value:$d{value}][display:$d{display}][name:$d{name}]";
    }  
}


sub fb_timeout
{
    my $FB_TIMEOUT = 5.0;
    my $timefile = "../fb.time";
    
    if ($ENV{HTTP_USER_AGENT} =~ /^facebookexternalhit/) 
    {
        if (!-e $timefile) {open (TF,">$timefile") || die("cannot create $timefile : $!");close TF;}
        open (TF,$timefile) || die("cannot read $timefile : $!");
        my @t = <TF>;
        close TF;
    
        my $t_old = $t[0];
        $t_old =~ s/\D//g;
        my $t_now = time();
    
        if ($t_now - $t_old < $FB_TIMEOUT) {
           print "Status: 503 Service Temporarily Unavailable\n";
           print "Content-Type: text/html; charset=UTF-8;\n";
           print "Retry-After: 5\r\n\r\n";
           die();
        } else {
          open (TF,">$timefile") || die("cannot write $timefile : $!");
          print TF $t_now;
          close TF; 
        }
    } 
}

################################################################################
# INSERT_TEXT
################################################################################
sub insert_text
{
     my $dbh = $_[0];
     my $txt = $_[1];
     my $lg = $_[2] || $config{current_language};
     my $txt_src = $_[3];
    
     if($config{version_num} >= 4000)
     {
         my $table_txt_src = 'txtcontents';
         
         if($txt_src ne '')
         {
            $table_txt_src = $txt_src.'_'.$table_txt_src;
         }
         
         $stmt = "INSERT INTO $table_txt_src (lg$lg) VALUES ('$txt')";
         execstmt($dbh,$stmt);
         my $id_textid = $dbh->{'mysql_insertid'};
    
         return $id_textid; 
     }
     else
     {
         my ($stmt,$rc,$id_textid);
         # INSERT TEXTID
         $stmt = "INSERT INTO textids (last_update) VALUES (NOW())";
         execstmt($dbh,$stmt);
         my $id_textid = $dbh->{'mysql_insertid'};
         # INSER T TEXTCONTENT
         $stmt = "INSERT INTO textcontents (id_textid,id_language,content) VALUES ($id_textid,$lg,'$txt')";
         execstmt($dbh,$stmt);
         return $id_textid; 
     }
}

# sub error_404
# {
# # $config{charset} = get_charset($dbh,$config{current_language});
# 
#  print $cgi->header( 
# #                -url => "https://www.germainecollard.com/404",
#                 -type => "text/html",
#                 -status=>"404 Not Found",
#                 -expires=>'-1d',
#                 -charset=>'UTF8',
#               );
# 
# # print "Status: 404 Not Found\n\n";
# #see();
# # if ($config{rewrite_404_id_language} > 0 && $config{rewrite_404_id_page} > 0) 
# # {
# #     
# # }
# #   my $out_name = $config{default_url};
# #     if()
# #     cgi_redirect($config{default_url});
#  exit;
# }



1;