--- /dev/null
+package NB::Functions;
+use strict;
+
+use Encode qw(&encode &decode &encode_utf8 &decode_utf8 &from_to);
+use Carp;
+
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $VAR1);
+
+use Exporter;
+
+use vars qw(
+ @DBI $DB $STH $TMP_DIR $DATA_DIR $ROOT_DIR
+ $DB_HOST $DB_PORT $DB_NAME $DB_USER $DB_PASS
+ %OVH_NICS $OVH_NIC $OVH_PASSWORD
+);
+
+our $DB_CHARACTER_SET_RESULTS = 'utf8';
+
+our %CHAR_ACCENT = (
+ 'a' => ['å','à','á','â','ä','ã'],
+ 'A' => ['À','Á','Å','Â','Ä','Ã'],
+ 'c' => ['ç'],
+ 'C' => ['Ç'],
+ 'e' => ['é','è','ê','ë'],
+ 'E' => ['È','Ê','Ë','É'],
+ 'i' => ['ì','î','ï','í'],
+ 'I' => ['Ì','Í','Î','Ï'],
+ 'n' => ['ñ'],
+ 'N' => ['Ñ'],
+ 'o' => ['ø','ò','ô','ö','õ','ó'],
+ 'O' => ['Ò','Ó','Ô','Ö','Õ','Ø'],
+ 's' => ['¨'],
+ 'S' => ['¦'],
+ 'u' => ['ù','ú','û','ü'],
+ 'U' => ['Ù','Ú','Û','Ü'],
+ 'y' => ['ý','ÿ'],
+ 'Y' => ['¾','Ý'],
+ 'z' => ['¸'],
+ 'Z' => ['´'],
+
+);
+#%CHAR_ACCENT = map{$_=>[ map{&Encode::encode('utf8',$_)} @{$CHAR_ACCENT{$_}} ]} keys %CHAR_ACCENT;
+#use Data::Dumper; die Dumper(\%CHAR_ACCENT);
+
+our %CHAR_ENTITIES = (
+ '"' => '"',
+ '&' => '&',
+ '<' => '<',
+ '>' => '>',
+ '¤' => '€',
+ '...' => '…',
+ '/-' => '†',
+ '/=' => '‡',
+ '0/00' => '‰',
+ '`' => '‘',
+ '-' => '–',
+ '—' => '—',
+ '\'-' => '‾',
+ '(TM)' => '™',
+ 'oe' => 'œ',
+ ' ' => 'Espace',
+ '¡' => '¡',
+ '¢' => '¢',
+ '£' => '£',
+ '¤' => '¤',
+ '¥' => '¥',
+ '¦' => '¦',
+ '§' => '§',
+ '¨' => '¨',
+ '©' => '©',
+ 'ª' => 'ª',
+ '«' => '«',
+ '¬' => '¬',
+ '­' => 'Tiret',
+ '®' => '®',
+ '¯' => '¯',
+ '°' => '°',
+ '±' => '±',
+ '²' => '²',
+ '³' => '³',
+ '´' => '´',
+ 'µ' => 'µ',
+ '¶' => '¶',
+ '·' => '·',
+ '¸' => '¸',
+ '¹' => '¹',
+ 'º' => 'º',
+ '»' => '»',
+ '¼' => '¼',
+ '½' => '½',
+ '¾' => '¾',
+ '¿' => '¿',
+ 'À' => 'À',
+ 'Á' => 'Á',
+ 'Â' => 'Â',
+ 'Ã' => 'Ã',
+ 'Ä' => 'Ä',
+ 'Å' => 'Å',
+ 'Æ' => 'Æ',
+ 'Ç' => 'Ç',
+ 'È' => 'È',
+ 'É' => 'É',
+ 'Ê' => 'Ê',
+ 'Ë' => 'Ë',
+ 'Ì' => 'Ì',
+ 'Í' => 'Í',
+ 'Î' => 'Î',
+ 'Ï' => 'Ï',
+ 'Ð' => 'Ð',
+ 'Ñ' => 'Ñ',
+ 'Ò' => 'Ò',
+ 'Ó' => 'Ó',
+ 'Ô' => 'Ô',
+ 'Õ' => 'Õ',
+ 'Ö' => 'Ö',
+ '×' => '×',
+ 'Ø' => 'Ø',
+ 'Ù' => 'Ù',
+ 'Ú' => 'Ú',
+ 'Û' => 'Û',
+ 'Ü' => 'Ü',
+ 'Ý' => 'Ý',
+ 'Þ' => 'Þ',
+ 'ß' => 'ß',
+ 'à' => 'à',
+ 'á' => 'á',
+ 'â' => 'â',
+ 'ã' => 'ã',
+ 'ä' => 'ä',
+ 'å' => 'å',
+ 'æ' => 'æ',
+ 'ç' => 'ç',
+ 'è' => 'è',
+ 'é' => 'é',
+ 'ê' => 'ê',
+ 'ë' => 'ë',
+ 'ì' => 'ì',
+ 'í' => 'í',
+ #"\x{00ED}" => 'í',
+ #"í" => 'í',
+ 'î' => 'î',
+ 'ï' => 'ï',
+ 'ð' => 'ð',
+ 'ñ' => 'ñ',
+ 'ò' => 'ò',
+ 'ó' => 'ó',
+ 'ô' => 'ô',
+ 'õ' => 'õ',
+ 'ö' => 'ö',
+ '÷' => '÷',
+ 'ø' => 'ø',
+ 'ú' => 'ú',
+ 'û' => 'û',
+ 'ü' => 'ü',
+ 'ý' => 'ý',
+ 'þ' => 'þ',
+ 'ÿ' => 'ÿ',
+);
+
+@ISA = qw(Exporter);
+@EXPORT = ();
+
+# Vim dump all functions: r!perl -ne '/^sub (\w+)/ and print "\t&$1\n"' %
+@EXPORT_OK = qw(
+ &dbi_err
+ &epoch2date
+ &price_from_to
+ &sec2h
+ &oct2h
+ &format_amount
+ &mysql_exec
+ &table_get_no_primaries
+ &table_get_primaries
+ &table_get_indexs
+ &table_drop_indexs
+ &table_is_myisam
+ &db_disconnect
+ &db_connect_master_local
+ &db_connect_master
+ &db_connect
+ &db_init
+ &html2txt
+ &sql_quote
+ &html_fix_entities
+ &html_unescape_fix_err
+ &html_unescape
+ &encoding_is_utf8
+ &encoding_is_latin
+ &del_accent
+ &clean_code
+ &opt_split
+ &new
+ &id_if_code
+ ¤t_date
+ ¤t_timestamp
+ &big_select_start
+ &big_select_fetch
+ &big_select_finish
+ &fixErrEncoding
+ &fix_latin1
+ &query_exec
+ &str_trim
+ &str2queries
+ &str_replace
+ &db_table2csv
+ &db_csv2table
+ &key2id
+ &file_encoding
+ &http_logs_argv
+);
+
+#@EXPORT = @EXPORT_OK;
+push(@EXPORT_OK,@EXPORT) if @EXPORT;
+
+$EXPORT_TAGS{all} = [@EXPORT_OK];
+#%EXPORT_TAGS = (all => 'sql_quote');
+
+$main::DEBUG||=0;
+
+sub dbi_err {
+#------------------------------------------------------------------------------
+# NB 09.04.11
+#------------------------------------------------------------------------------
+ return " ".join("/",@DBI[0..$#DBI-1]).": $DBI::err: $DBI::errstr";
+}
+
+sub epoch2date {
+#------------------------------------------------------------------------------
+# NB 27.07.10
+#------------------------------------------------------------------------------
+ require 'Date/Manip.pm' unless $INC{'Date/Manip.pm'};
+ return &Date::Manip::UnixDate(&Date::Manip::ParseDateString("epoch ".$_[0]),'%Y-%m-%d %H:%M:%S');
+}
+
+sub price_from_to {
+#------------------------------------------------------------------------------
+# NB 28.10.09
+#------------------------------------------------------------------------------
+my ($p,$f,$t) = @_;
+
+ local $_;
+
+ unless ($main::price_from_to_currency) {
+ &db_connect() unless $DB;
+ $_ = "SELECT code,rate FROM currency";
+ %main::price_from_to_currency = map {$_->[0]=>$_->[1]} @{ $DB->selectall_arrayref($_) };
+ #use Data::Dumper; warn Dumper(\%main::price_from_to_currency);
+ }
+
+ if ($t eq 'EUR') {
+ $p *= $main::price_from_to_currency{$f};
+ } elsif ($f eq 'EUR') {
+ $p /= $main::price_from_to_currency{$t};
+ } else {
+ die "Not implemented!";
+ }
+
+ return sprintf('%.2f',$p);
+}
+
+sub sec2h {
+
+ my $time = shift;
+
+ my $days = int($time / 86400);
+ $time -= ($days * 86400);
+
+ my $hours = int($time / 3600);
+ $time -= ($hours * 3600);
+
+ my $minutes = int($time / 60);
+ my $seconds = $time % 60;
+
+ return sprintf("\%d day(s) %02d:%02d:%02d",$days,$hours,$minutes,$seconds);
+
+# NB 10.05.11 my $time = shift @_;
+# NB 10.05.11
+# NB 10.05.11 my $d = int(($time / (60 * 60 * 60))+0.6);
+# NB 10.05.11
+# NB 10.05.11 my $h = int($time / (60 * 60))-($d*24);
+# NB 10.05.11
+# NB 10.05.11 my $m = int($time / 60) % 60;
+# NB 10.05.11
+# NB 10.05.11 my $s = $time % 60;
+# NB 10.05.11
+# NB 10.05.11 return sprintf("\%d day(s) %02d:%02d:%02d",$d,$h,$m,$s);
+
+}
+
+sub oct2h {
+
+ my $o = shift @_;
+
+ if ($o >= 1099511627776) { return(sprintf('%.2fT',($o/1099511627776))); } # T
+ elsif ($o >= 1073741824) { return(sprintf('%.2fG',($o/1073741824))); } # G
+ elsif ($o >= 1048576) { return(int($o/1048576)."M"); } # M
+ elsif ($o >= 1024) { return(int($o/1024)."K"); } # K
+ else { return $o."bytes"; }
+
+}
+
+sub format_amount {
+#------------------------------------------------------------------------------
+# NB 14.05.09
+#------------------------------------------------------------------------------
+my $amount = shift @_;
+ if ($amount =~ /\..*,/
+ #or $amount =~ /\.\d\d\d/
+ ) {
+ $amount =~ s/\.//g;
+ $amount =~ s/,/\./g;
+ } elsif ($amount =~ /,.*\./) {
+ $amount =~ s/,//g;
+ } else {
+ $amount =~ s/,/\./g;
+ }
+ return unless $amount =~ /^[\.\d]+$/;
+return $amount;
+}
+
+sub mysql_exec {
+#------------------------------------------------------------------------------
+# NB 17.03.09
+#------------------------------------------------------------------------------
+my $q = shift @_;
+@_ = ("mysql",$DB_NAME,"--host",$DB_HOST,"--port",$DB_PORT,"--user",$DB_USER,"--password",$DB_PASS
+ ,"-NBe",$q);
+@_ = ("mysql",$DB_NAME,"-h",$DB_HOST,"-P",$DB_PORT,"-u",$DB_USER,"-p$DB_PASS"
+ ,"-NBe",$q);
+return wantarray ? @_ : join(' ',@_);
+}
+
+sub table_get_no_primaries {
+#------------------------------------------------------------------------------
+# NB 17.03.09
+#------------------------------------------------------------------------------
+my $table = shift @_;
+$main::table_get_no_primaries ||= {};
+ unless ($main::table_get_no_primaries{$table}) {
+ $main::table_get_no_primaries{$table} = [
+ map {$_->[4]} grep {$_->[2] ne 'PRIMARY'} @{$DB->selectall_arrayref("SHOW INDEX FROM `$table`")}
+ ];
+ }
+return wantarray ? @{$main::table_get_no_primaries{$table}} : $main::table_get_no_primaries{$table};
+}
+
+sub table_get_primaries {
+#------------------------------------------------------------------------------
+# NB 17.03.09
+#------------------------------------------------------------------------------
+my $table = shift @_;
+$main::table_get_primaries ||= {};
+ unless ($main::table_get_primaries{$table}) {
+ $main::table_get_primaries{$table} = [
+ map {$_->[4]} grep {$_->[2] eq 'PRIMARY'} @{$DB->selectall_arrayref("SHOW INDEX FROM `$table`")}
+ ];
+ }
+return wantarray ? @{$main::table_get_primaries{$table}} : $main::table_get_primaries{$table};
+}
+
+sub table_get_indexs {
+#------------------------------------------------------------------------------
+# NB 13.03.09
+#------------------------------------------------------------------------------
+my $table = shift @_;
+$main::table_get_indexs ||= {};
+ $main::table_get_indexs{$table} = [ keys %{$DB->selectall_hashref("SHOW INDEX FROM `$table`",'Key_name')} ]
+ unless $main::table_get_indexs{$table};
+return wantarray ? @{$main::table_get_indexs{$table}} : $main::table_get_indexs{$table};
+}
+
+sub table_drop_indexs {
+#------------------------------------------------------------------------------
+# NB 13.03.09
+#------------------------------------------------------------------------------
+my (@tables) = @_;
+my ($i,$table);
+$i = 0;
+for $table (@tables) {
+ $_ = "SHOW INDEX FROM `$table`";
+ @_ = keys %{$DB->selectall_hashref($_,'Key_name')};
+ for (@_) {
+ if ($_ eq 'PRIMARY') {
+ $_ = "ALTER TABLE `$table` DROP PRIMARY KEY";
+ } else {
+ $_ = "ALTER TABLE `$table` DROP index $_";
+ }
+ $DB->do($_) and $i++;
+ }
+}
+return $i;
+}
+
+sub table_is_myisam {
+my ($table) = @_;
+return $main::table_is_myisam{$table} if defined($main::table_is_myisam{$table});
+$main::table_is_myisam{$table} = lc(($DB->selectrow_array("SHOW TABLE STATUS LIKE '$table'"))[1]) eq 'myisam' ? 1 : 0;
+return $main::table_is_myisam{$table};
+}
+
+sub db_disconnect {
+#------------------------------------------------------------------------------
+# NB 24.06.08
+#------------------------------------------------------------------------------
+ $STH->finish if $STH;
+ if ($DB) {
+ $DB->do('SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS');
+ $DB->do('SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS');
+# NB 27.01.13 if $TEST $DB->commit if !$DB->{AutoCommit};
+ $DB->disconnect;
+ }
+}
+
+sub db_connect_master_local {
+
+# Bug if delete - NB 24.02.12 my $opt = shift @_;
+my $opt = \%{$_[0]};
+
+ $opt->{PrintError} = 0 unless defined $opt->{PrintError};
+ $opt->{RaiseError} = 0 unless defined $opt->{RaiseError};
+ $opt->{nodie} = 1;
+
+ $_ = &db_connect_master($opt) and return $_;
+
+ delete($opt->{nodie});
+
+ $_ = &db_connect({PrintError=>0,RaiseError=>0}) and return $_;
+
+ Carp::confess "$0: ".$DBI[0].": $DBI::errstr";
+
+}
+
+sub db_connect_master {
+#------------------------------------------------------------------------------
+# NB 26.06.09
+#------------------------------------------------------------------------------
+# Bug if delete - NB 24.02.12 my $opt = shift @_;
+my $opt = \%{$_[0]};
+
+ require 'Net/Ping.pm';
+ my $p = Net::Ping->new('syn',5); $p->{port_num} = 3306;
+
+ my @hosts = $opt->{hosts} ? @{$opt->{hosts}} : ($ENV{NB_DB_MASTER_HOST} || 'admin.izideal.'.($ENV{NB_VPN} ? 'vpn' : 'com'));
+# NB 29.05.12 @_ = ();
+# NB 29.05.12 push(@_,'admin.izideal.vpn') if $ENV{NB_VPN};
+# NB 29.05.12 $opt->{hosts} and @_ = @{$opt->{hosts}};
+
+ for my $host (@hosts) {
+
+ #warn "$host: ".$p->ping($host);
+ next unless $p->ping($host);
+
+ $opt->{host} = $host;
+ $opt->{port} = $p->{port_num};
+
+ $p->close();
+
+ return &db_connect($opt);
+ }
+
+ $p->close();
+ return;
+
+}
+
+sub db_connect {
+#------------------------------------------------------------------------------
+# NB 15.07.07
+#------------------------------------------------------------------------------
+# Bug if delete - NB 24.02.12 my $opt = shift @_;
+my $opt = \%{$_[0]};
+my $iziopt;
+my @dbi = @NB::Globals::DBI;
+
+require 'DBI.pm' unless $INC{'DBI.pm'};
+
+ $opt->{timeout} ||= 43200; # NB 12.06.11 12 hours, -1 disconnect immediatly since 5.1.49-3-log (Debian)
+
+ %$iziopt = $opt ? %$opt : ();
+ foreach (qw(hosts nodie cache utf8 timeout bin_log dbi)) {
+ next unless exists $opt->{$_};
+ #$iziopt->{$_} = $opt->{$_};
+ delete($opt->{$_});
+ }
+
+ $opt->{mysql_socket} = '' if $opt->{host};
+
+ foreach (qw(host port mysql_socket dbname)) {
+
+ next unless exists $opt->{$_};
+
+ $dbi[0] =~ s/([;:])$_=[^;]+/$1$_=$opt->{$_}/;
+
+ if ($_ eq 'host') {
+ $DB_HOST = $opt->{$_};
+ } elsif ($_ eq 'port') {
+ $DB_PORT = $opt->{$_};
+ } elsif ($_ eq 'dbname') {
+ $DB_NAME = $opt->{$_};
+ }
+
+ delete($opt->{$_});
+
+ }
+
+ #warn join(' | ',@dbi);
+ return wantarray ? @dbi : \@dbi if $iziopt->{dbi};
+
+ #$opt->{TraceLevel} = 5;
+ unless ($DB = DBI->connect(@dbi,$opt)) {
+ Carp::confess "$0: ".$dbi[0].": $DBI::errstr" unless $iziopt->{nodie};
+ return;
+ }
+
+ &db_init($DB,$iziopt);
+# NB 01.02.12 Bug - &db_init($DB,$izi);
+
+ $DB_CHARACTER_SET_RESULTS = $DB->selectrow_array('SELECT @@character_set_results');
+
+ return $DB;
+
+}
+
+sub db_init {
+#------------------------------------------------------------------------------
+# NB 25.03.09
+#------------------------------------------------------------------------------
+my $db = shift @_;
+my $iziopt = shift @_;
+
+# NB 30.03.11 doesn't work in new mysql version $iziopt->{timeout} ||= -1;
+ $iziopt->{timeout} ||= 28800;
+ $iziopt->{bin_log} = 1 unless defined $iziopt->{bin_log};
+ $db->do("SET SESSION wait_timeout=".$iziopt->{timeout});
+ $db->do("SET SESSION interactive_timeout=".$iziopt->{timeout});
+
+# NB 28.03.11 version 5.1.49-3-log: 2013: Lost connection to MySQL server during query
+# $db->do("SET SESSION net_read_timeout=".$iziopt->{timeout});
+# $db->do("SET SESSION net_write_timeout=".$iziopt->{timeout});
+ $db->do("SET SESSION net_read_timeout=".($iziopt->{timeout}<0 ? 28800 : $iziopt->{timeout}));
+ $db->do("SET SESSION net_write_timeout=".($iziopt->{timeout}<0 ? 28800 : $iziopt->{timeout}));
+
+ $db->do("SET SESSION query_cache_type=0") if defined($iziopt->{cache}) and !$iziopt->{cache};
+
+ $db->do('SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0');
+ $db->do('SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0');
+
+ $db->do("SET SESSION SQL_LOG_BIN=0") if !$iziopt->{bin_log};
+
+ if ($iziopt->{utf8}) {
+ $db->do("SET NAMES UTF8");
+ $db->do("SET SESSION character_set_database=utf8");
+ }
+
+ $db->{LongReadLen} = 1000000;
+ #$DB_CHARACTER_SET_RESULTS = $db->selectrow_array('SELECT @@character_set_results');
+return $db;
+}
+
+sub html2txt {
+
+my $v = shift @_;
+
+ # New line
+ $v =~ s,
+ (
+ (<|<)(tr|li|)(\s+[^>])*>
+ )
+ |
+ (
+ (<|<)(br|hr)(\s*/\s*)?>
+ )
+ |
+ ( \\n )
+ ,\n,gix;
+
+ # Delete
+ $v =~ s,
+ ( (<|<)/?\w+(\s+\w+=['"]+[^'"]+['"]+)*/?(>|>) )
+ |( (<|<)?\w+(\s+\w+=\S+)*/?(>|>) )
+
+ #|( <\w[^>]+> )
+
+ |( (<|<)!\[CDATA\[ ) # cdata begin
+ | ( \]\](>|>) ) # cdata end
+
+ |( (<|<)/\w+\s*$ ) # incomplet html
+ |( ^(<|<)\w+ .* ) # incomplet html
+ |(<\!DOCTYPE[^>]+>)
+ ,,gix;
+
+ $v =~ s/[\f ]+/ /g;
+ &str_trim($v);
+
+ return $v;
+
+}
+
+sub sql_quote {
+#------------------------------------------------------------------------------
+# NB 21.06.07
+#------------------------------------------------------------------------------
+my ($str) = @_;
+ $str =~ s/\\+/\\/g;
+ $str =~ s/\\*'/\\'/g;
+ $str =~ s/\\$//;
+ return "'".$str."'";
+}
+
+sub html_fix_entities {
+#------------------------------------------------------------------------------
+# NB 12.10.11
+# ; missing
+#------------------------------------------------------------------------------
+my $str = shift @_;
+ $str =~ s/(&#\d\d\d?)([^\d;])/$1;$2/g;
+ return $str;
+}
+
+#die &html_unescape_fix_err("Karcher &ndash Balayeuse é");
+#die &html_unescape_fix_err("Pull 4 capuche Juventus FC Core pour Garçon (8-15 ans)");
+sub html_unescape_fix_err {
+#------------------------------------------------------------------------------
+# NB 09.03.10
+#------------------------------------------------------------------------------
+my $str = shift @_;
+my $encode = shift @_; $encode ||= "utf8";
+my $html;
+
+ $str = &html_unescape($str,$encode);
+
+ foreach (keys %CHAR_ENTITIES) {
+ $html = $CHAR_ENTITIES{$_};
+ $html =~ s/;$//g; # when ; missing
+ $str =~ s/$html(\s|$)/$_/g;
+ }
+
+ #require CGI unless $INC{'CGI.pm'};
+ #$str =~ s/(&#?[\w\d]+(?:\s|$))/&Encode::encode($encode,&CGI::unescapeHTML("$1"))/ge; # ; missing
+
+return $str;
+
+}
+
+#die &html_unescape("einbaufähig | Zaza é é | Nike Chaussure Air Jordan Phat&#1601 pour Fille") if $ARGV[0] eq 'zaza';
+sub html_unescape {
+#------------------------------------------------------------------------------
+# NB 22.03.07
+# Replace html entities with proper char
+#------------------------------------------------------------------------------
+my $str = shift @_;
+my $encode = shift @_; $encode ||= "utf8";
+
+ $str =~ s/&(#?[^;]+;)/&$1/g;
+
+#require HTML::Entities unless $INC{'HTML/Entities.pm'};
+#require Text::Unidecode unless $INC{'Text/Unidecode.pm'};
+#return &Text::Unidecode::unidecode(&HTML::Entitie::decode_entities($str));
+
+# use Data::Dumper; print Dumper(\%CHAR_ENTITIES)."\n";
+ foreach my $char (keys %CHAR_ENTITIES) {
+ my $ent = $CHAR_ENTITIES{$char};
+
+ #$char = &Encode::encode($encode,$char) if !&encoding_is_utf8($encode);
+ #&Encode::from_to($char,"utf8",$encode) if !&encoding_is_utf8($encode);
+ #$str =~ s/$ent/$char/g;
+
+ #$char = &Encode::decode('utf8',$char);
+ $str =~ s/\Q$ent\E/$char/g;
+ }
+ #return $str;
+
+ require CGI unless $INC{'CGI.pm'};
+ if (&encoding_is_latin($encode)) {
+ $str =~ s/(&#\w+;)/&CGI::unescapeHTML("$1")/ge;
+# NB 25.06.12 $str =~ s/(&\w+;)/&CGI::unescapeHTML("$1")/ge;
+ } else {
+ $str =~ s/(&#\w+;)/&Encode::encode($encode,&CGI::unescapeHTML("$1"))/ge;
+# NB 25.06.12 $str =~ s/(&\w+;)/&Encode::encode($encode,&CGI::unescapeHTML("$1"))/ge;
+ }
+
+return $str;
+
+}
+
+sub encoding_is_utf8 {
+#------------------------------------------------------------------------------
+# NB 02.12.11
+#------------------------------------------------------------------------------
+ return ( $_[0] and $_[0] =~ /^utf-?8$/i ? 1 : 0 );
+}
+
+sub encoding_is_latin {
+#------------------------------------------------------------------------------
+# NB 02.12.11
+#------------------------------------------------------------------------------
+ return ( $_[0] and $_[0] =~ /iso-8859-1|latin1/i ? 1 : 0 );
+}
+
+#die &del_accent("é");
+sub del_accent {
+#------------------------------------------------------------------------------
+# NB 31.01.07
+#------------------------------------------------------------------------------
+my $str = shift @_;
+my $charset = shift @_;
+return $str unless $str;
+$charset = "utf8" if !$charset or $charset =~ /^utf-?8$/i;
+
+ # Ram cache
+ $main::from_to{$charset} = {
+ map {
+ my $to = $_;
+ my $from = join('|',
+
+ ($charset eq 'utf8'
+ ? @{$CHAR_ACCENT{$_}}
+ : map {&Encode::from_to($_,"utf8",$charset); $_ } @{$CHAR_ACCENT{$_}}
+ )
+ );
+
+ {$from => $to};
+
+ } keys %CHAR_ACCENT } if !%main::from_to or !$main::from_to{$charset};
+
+ # Delete accents
+ while (my ($from,$to) = each(%{$main::from_to{$charset}})) {
+ #&Encode::from_to($from,"utf8",$charset) if $charset !~ /^utf-?8$/i;
+ $str =~ s/$from/$to/g;
+ }
+
+ return $str;
+}
+
+# NB 06.12.11 sub del_accent_new {
+# NB 06.12.11
+# NB 06.12.11 my ($str,$charset) = @_;
+# NB 06.12.11
+# NB 06.12.11 require HTML::Entities unless $INC{'HTML/Entities.pm'};
+# NB 06.12.11 $charset ||= $DB_CHARACTER_SET_RESULTS;
+# NB 06.12.11
+# NB 06.12.11 if (1 and ($charset ne 'latin1')) {
+# NB 06.12.11 &Encode::from_to($str, $charset,"iso-8859-1")
+# NB 06.12.11 #$str = &Encode::encode("latin1", &Encode::decode($charset, $str));
+# NB 06.12.11 #warn $str;
+# NB 06.12.11 #Encode::from_to($str, $charset,"latin1")
+# NB 06.12.11 }
+# NB 06.12.11
+# NB 06.12.11 $str = &HTML::Entities::encode_entities($str);
+# NB 06.12.11
+# NB 06.12.11 $str =~ s/\&([A-za-z])(?:uml|circ|tilde|acute|grave|cedil|ring)\;/$1/g;
+# NB 06.12.11 $str =~ s/\&([A-za-z]{2})(?:lig)\;/$1/g; # pour les ligatures e.g. 'œ'
+# NB 06.12.11 $str =~ s/\&[^;]+\;//g; # supprime les autres caractères
+# NB 06.12.11
+# NB 06.12.11 return $str;
+# NB 06.12.11 }
+
+sub clean_code {
+#------------------------------------------------------------------------------
+# NB 20.03.07
+#------------------------------------------------------------------------------
+ my $code = shift @_;
+ return $code unless $code;
+ $code = &del_accent($code);
+ $code = lc($code);
+ $code =~ s/\W+//g;
+return $code;
+}
+
+sub opt_split {
+#------------------------------------------------------------------------------
+# NB 06.12.06
+#------------------------------------------------------------------------------
+local $_;
+my $opt = shift;
+my $exp = shift; $exp ||= '[,;\s]+';
+ @_ = grep {$_} map {&str_trim($_); $_} split(/$exp/,$opt);
+return @_;
+}
+
+sub new {
+#------------------------------------------------------------------------------
+# NB 28.04.04
+#------------------------------------------------------------------------------
+my ($proto,%p) = @_;
+my $class = ref($proto) || $proto;
+my $self;
+ %$self = %p;
+bless($self,$class);
+return $self;
+}
+
+sub id_if_code {
+#------------------------------------------------------------------------------
+# NB 13.01.07
+#------------------------------------------------------------------------------
+my ($table,@code) = @_;
+
+my ($code,$i,@ret,$STH);
+
+my $NAME = 'id_if_code()';
+
+local $_;
+
+for ($i=0;$i<@code;$i++) {
+
+ $code = $code[$i];
+
+ if ($code and $code !~ /^\d+$/) {
+
+ $_ = "SELECT id FROM `$table` WHERE code=".$DB->quote($code);
+
+ $STH = $DB->prepare($_) || die $DBI::errstr;
+ $STH->execute || die $DBI::errstr;
+
+ $STH->rows || die "$NAME: error: unknow vendor: $code";
+
+ $code = $STH->fetchrow;
+
+ $STH->finish;
+ }
+
+ #push(@ret,$code);
+ $code[$i] = $code;
+
+}
+
+return wantarray ? @code : $code[0];
+}
+
+#die &vendor_file({id=>11,url=>'http://flux.netaffiliation.com/catalogue.php?maff=850DFEEES314D48704181&lang=pt&type=csv'},'download_conf');
+sub current_date {
+ return sub{
+ sprintf("%04d-%02d-%02d",$_[5]+1900,$_[4]+1,$_[3])
+ }->($_[0] ? localtime($_[0]) : localtime());
+}
+
+sub current_timestamp {
+ return sub{
+ sprintf("%04d-%02d-%02d",$_[5]+1900,$_[4]+1,$_[3]) . ' '
+ . sprintf("%02d:%02d:%02d",$_[2],$_[1],$_[0])
+ }->($_[0] ? localtime($_[0]) : localtime());
+}
+
+sub big_select_start {
+
+ my ($sql,$method)=@_;
+
+ $method ||= 'fetchrow_hashref';
+ $main::big_select_method = $method;
+ $main::big_select_disk = $_[2];
+ my (
+ $log,
+ $NAME,
+ $tot,
+ $rec,
+ %mem,
+ );
+ $main::big_select_verbose||=0;
+ $NAME = 'big_select_start';
+
+ # ram memory
+ $log = "$NAME: source_import: ";
+
+ if ($main::big_select_disk) {
+
+ require 'Digest/MD5.pm' unless $INC{'Digest/MD5.pm'};
+ require 'Data/Dumper.pm' unless $INC{'Data/Dumper.pm'};
+
+ $_ = Digest::MD5::md5_hex($sql);
+
+ $main::big_select_dumpf = "$TMP_DIR/big_select-$_.dumper";
+
+ $log .= $main::big_select_dumpf;
+ #$log =~ s,^.*?([^/]+)$,$1,;
+ print $log if $main::big_select_verbose;
+
+ if (-e $main::big_select_dumpf) {
+
+ warn "\n$NAME: WARN: use $main::big_select_dumpf, no select on source_import\n";
+ $tot=`wc -l $main::big_select_dumpf|cut -d ' ' -f1`;
+ chomp($tot);
+
+ } else {
+
+ $DB->do("SET SESSION net_read_timeout=-1");
+ $DB->do("SET SESSION net_write_timeout=-1");
+ $mem{mysql_use_result} = $DB->{mysql_use_result};
+ $DB->{mysql_use_result} = 1;
+
+ $main::big_select_sth = $DB->prepare($sql) || die $DBI::errstr;
+ $main::big_select_sth->execute || die $DBI::errstr;
+
+ open(BIG_SELECT_DUMP,">$main::big_select_dumpf") or die "$NAME: $_: $!";
+
+ $mem{'Data::Dumper::Indent'} = $Data::Dumper::Indent;
+ $mem{'Data::Dumper::Useqq'} = $Data::Dumper::Useqq;
+ $Data::Dumper::Indent = 0;
+ $Data::Dumper::Useqq = 1;
+
+ $tot=0;
+
+ while ($rec = $main::big_select_sth->$method) {
+
+ print BIG_SELECT_DUMP &Data::Dumper::Dumper($rec)."\n";
+ $tot++;
+ print "\r$log: $tot records" if $main::big_select_verbose>2;
+ }
+
+ close BIG_SELECT_DUMP;
+
+ $main::big_select_sth->finish;
+
+ $DB->{mysql_use_result} = $mem{mysql_use_result};
+ $Data::Dumper::Indent = $mem{'Data::Dumper::Indent'};
+ $Data::Dumper::Useqq = $mem{'Data::Dumper::Useqq'};
+ }
+
+ open(BIG_SELECT_DUMP,$main::big_select_dumpf) or die "$NAME: $_: $!";
+
+ } else {
+
+ $main::big_select_sth = $DB->prepare($sql) || die $DBI::errstr;
+ $main::big_select_sth->execute || die $DBI::errstr;
+ $tot = $main::big_select_sth->rows;
+
+ }
+
+ END { &big_select_finish(); }
+ return $main::big_select_method=$tot;
+
+}
+
+sub big_select_fetch {
+
+ return $main::big_select_sth->$main::big_select_method unless $main::big_select_disk;
+
+ defined($_ = <BIG_SELECT_DUMP>) or return;
+
+ chomp($_);
+ $VAR1 = {};
+ eval "$_";
+
+ warn "big_select_fetch: $@" if $@;
+ return $VAR1;
+
+}
+
+sub big_select_finish {
+
+ if ($main::big_select_disk) {
+ close BIG_SELECT_DUMP;
+ $main::big_select_dumpf and -e $main::big_select_dumpf and unlink $main::big_select_dumpf;
+ } else {
+ $main::big_select_sth->finish if $main::big_select_method;
+ }
+
+}
+
+sub fixErrEncoding {
+###############################################################################
+# NB 03.12.11
+# Fix utf8 err encoding
+###############################################################################
+my $str = $_[0];
+my $charset = $_[1]; $charset = "utf8" if !$charset or $charset =~ /^utf-?8$/i;
+
+ # Ram cache
+ $main::fixErrEncoding{$charset} = {
+ map {
+
+ my ($from ,$to) = ($_,$_);
+
+ if ($charset eq 'utf8') {
+ $from = &encode_utf8($from);
+
+ } else {
+ $to = &encode($charset,$to);
+# NB 25.06.12 $from = &encode($charset,$to);
+ $from = &encode($charset,$from);
+
+ #&Encode::from_to($to,"utf8",$charset);
+
+ #&Encode::from_to($from,"utf8",$charset);
+ #&Encode::from_to($from,$charset,$charset);
+ }
+
+ { $from => $to };
+
+ } map { @{$CHAR_ACCENT{$_}} } keys %CHAR_ACCENT } if !%main::fixErrEncoding or !$main::fixErrEncoding{$charset};
+
+#use Data::Dumper; warn Dumper(\%main::fixErrEncoding);
+
+ # Delete accents
+ while (my ($from,$to) = each(%{$main::fixErrEncoding{$charset}})) {
+ $str =~ s/$from/$to/g;
+ }
+
+ return $str;
+
+}
+
+sub fix_latin1 {
+###############################################################################
+# NB 06.12.11
+# Fix latin err encoding
+# $str must be in latin1
+###############################################################################
+my $str = shift @_;
+my $charset = shift @_; $charset ||= "utf-8";
+
+ &Encode::from_to($str,$charset,"iso-8859-1") if !&encoding_is_latin($charset);
+
+# # Repair
+# $str =~ s/
+# ( [\x00-\x7F] # single-byte sequences 0xxxxxxx
+# | [\xC0-\xDF][\x80-\xBF] # double-byte sequences 110xxxxx 10xxxxxx
+# | [\xE0-\xEF][\x80-\xBF]{2} # triple-byte sequences 1110xxxx 10xxxxxx * 2
+# | [\xF0-\xF7][\x80-\xBF]{3} # quadruple-byte sequence 11110xxx 10xxxxxx * 3
+# )
+# | ( [\x80-\xBF] ) # invalid byte in range 10000000 - 10111111
+# | ( [\xC0-\xFF] ) # invalid byte in range 11000000 - 11111111
+# /\xC2$1/x;
+# return $_;
+#
+# $str =~ s/
+# ( [\x00-\x7F] # single-byte sequences 0xxxxxxx
+# | [\xC0-\xDF][\x80-\xBF] # double-byte sequences 110xxxxx 10xxxxxx
+# | [\xE0-\xEF][\x80-\xBF]{2} # triple-byte sequences 1110xxxx 10xxxxxx * 2
+# | [\xF0-\xF7][\x80-\xBF]{3} # quadruple-byte sequence 11110xxx 10xxxxxx * 3
+# )
+# | . # anything else
+# /$1/x;
+# return $_;
+
+ require 'NB/Encoding/FixLatin.pm' unless $INC{'NB/Encoding/FixLatin.pm'};
+
+ #&Encode::from_to($str,$encoding,'iso-8859-1') if $encoding !~ /iso-8859|latin/i;
+
+ $str = &NB::Encoding::FixLatin::fix_latin($str);
+
+ &Encode::from_to($str,"iso-8859-1",$charset) if !&encoding_is_latin($charset);
+
+ return $str;
+# ## replace higher ASCII characters such as a-umlaut etc. with codes.
+# s#\x94#oumlautklein#g;
+# s#\x84#aumlautklein#g;
+# s#\x81#uumlautklein#g;
+# ## ... and some more. (ö, Ö, ä, Ä, Ü, ü, ê, è, é, É, â, á, à, ì, î,
+# ## û, ù, ô, ò, ç, ï, a°, e-umlaut and ñ in total.)
+#
+# ## replace problematic special characters (ß, ú, ó, í, ø, ') with codes.
+# s#(?<![\x80-\xFF])\xE1(?![\x80-\xFF])#eszett#g;
+# s#(?<![\x80-\xFF])\xA3(?![\x80-\xFF])#uaccentaiguklein#g;
+# s#(?<![\x80-\xFF])\xA2(?![\x80-\xFF])#oaccentaiguklein#g;
+# s#(?<![\x80-\xFF])\xA1(?![\x80-\xFF])#iaccentaiguklein#g;
+# s#(?<![\x80-\xFF])\xED(?![\x80-\xFF])#nordischesoklein#g;
+#return $_;
+}
+
+sub query_exec {
+#------------------------------------------------------------------------------
+# NB 19.06.08
+#------------------------------------------------------------------------------
+ my ($ret,$err);
+ #local $Carp::CarpLevel = 1;
+
+ $main::main::DB_OPT ||= {cache=>0};
+ $main::TEST ||= 0;
+
+ foreach (@_) {
+
+ warn "query_exec: $_\n" if $main::DEBUG;
+ $_ = "SELECT 1" if $main::TEST;
+
+ while (!($ret=$DB->do($_))) {
+
+ if ($DBI::err==2006
+ or $DBI::err==2013 # lost connection to db
+ or $DBI::err==1053 # shutdown
+ or $DBI::err==2003 # Can't connect to MySQL
+ or $DBI::err==1205 or $DBI::err==1213 # InnoDB lock timeout
+ ) {
+ $err++;
+ Carp::cluck "query_exec: lost connection to db: ".$DBI::err.": ".$DBI::errstr if $main::VERBOSE;
+ Carp::cluck "query_exec: abord can not connect to db" and last if $err>50;
+ $DB->disconnect if $DB;
+ Carp::cluck "query_exec: ".($DBI::err||"").": wait 20 seconds before reconnecting" if $main::VERBOSE;
+ sleep 20;
+ &db_connect($main::DB_OPT) or die "query_exec: $DBI::err: $DBI::errstr";
+
+ } else {
+ Carp::cluck "query_exec: process aborded: $DBI::err: $DBI::errstr:\n$_\n";
+ last;
+
+ }
+
+ }
+
+ }
+
+ return $ret;
+
+}
+
+sub str_trim {
+#------------------------------------------------------------------------------
+# NB 14.12.10
+#------------------------------------------------------------------------------
+# Not by ref !!! - NB 07.02.12
+ my $s = shift;
+ #$s =~ s/^\s+|\s+$//; # single
+ $s =~ s/^\s+//; $s =~ s/\s+$//; # double
+ return $s;
+}
+
+sub str2queries {
+#------------------------------------------------------------------------------
+# NB 04.06.08
+#------------------------------------------------------------------------------
+ my $str = join('',@_);
+ ($str) = @_;
+ $str =~ s,/\*.+?\*/,,msgx;
+ $str =~ s/-- [^\n]+//g;
+ my @q = grep {$_} map { s/^\s*-- [^\n]+//; s/[\r\n\t]+/ /g; s/\s*;\s*$//; s/^\s+//; $_} split(/(.*?);[\r\n]+/s,$str);
+ return wantarray ? @q : \@q;
+}
+
+sub str_replace {
+#------------------------------------------------------------------------------
+# NB 09.06.08
+#------------------------------------------------------------------------------
+my $subject = shift;
+my $search = shift;
+my $replace = shift;
+
+ if (! defined $subject) { return -1; }
+
+ my $count = shift;
+ if (! defined $count) { $count = -1; }
+
+ my ($i,$pos) = (0,0);
+ while ( (my $idx = index( $subject, $search, $pos )) != -1 )
+ {
+ substr( $subject, $idx, length($search) ) = $replace;
+ $pos=$idx+length($replace);
+ if ($count>0 && ++$i>=$count) { last; }
+ }
+
+ return $subject;
+}
+
+sub db_table2csv {
+#------------------------------------------------------------------------------
+# NB 24.06.08
+#------------------------------------------------------------------------------
+my ($sql,$csv,$call) = @_;
+$call ||= sub { $DB->do($_[0]); };
+$sql="$sql INTO OUTFILE '$csv'";
+my $ret = eval{&$call($sql)};
+Carp::cluck $@ if $@;
+return $ret;
+}
+
+sub db_csv2table {
+#------------------------------------------------------------------------------
+# NB 24.06.08
+#------------------------------------------------------------------------------
+my ($table,$csv,$call) = @_;
+$call ||= sub { $DB->do($_[0]); };
+my ($ret,$sql);
+my @sql=(
+ '/*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */',
+ '/*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */',
+ #'/*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */',
+);
+if (0) {
+ if (&table_is_myisam($table)) {
+ # MyIsam
+ push(@sql,
+ "SET SESSION BULK_INSERT_BUFFER_SIZE=".(1024*1000),
+ "SET SESSION MYISAM_SORT_BUFFER_SIZE=".(1024*1000),
+ #"SET GLOBAL KEY_BUFFER_SIZE=".(1024*1000),
+ );
+ } else {
+ # Innodb
+ push(@sql,
+ "SET SESSION innodb_buffer_pool_size=".(1024*1000),
+ "SET SESSION innodb_log_buffer_size=".(1024*1000),
+ );
+ }
+}
+push(@sql,
+# NB 17.01.14 Bug in source_import.brandfrom izi-download: "LOAD DATA ".($csv=~/\.fifo$/ ? 'LOCAL ':'')."INFILE '$csv' REPLACE INTO TABLE $table",
+# The used command is not allowed with this MySQL version - NB 11.04.14 "LOAD DATA ".($csv=~/\.fifo$/ ? 'LOCAL ':'')."INFILE '$csv' REPLACE INTO TABLE $table CHARACTER SET latin1",
+ "LOAD DATA INFILE '$csv' REPLACE INTO TABLE $table CHARACTER SET latin1",
+ '/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */',
+ '/*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */',
+);
+#die join("\n",@sql);
+ foreach $sql (@sql) {
+ if ($sql =~ /^LOAD DATA /) { $ret = eval {&$call($sql)} }
+ else { eval { &$call($sql)} }
+ Carp::cluck $@ if $@;
+ #last;
+ }
+ #$DB->commit unless $DB->{AutoCommit};
+return $ret;
+}
+
+#die &key2id('zaza');
+sub key2id {
+#------------------------------------------------------------------------------
+# NB 30.03.10
+#------------------------------------------------------------------------------
+ require 'NB/Math/BaseCnv.pm' unless $INC{'NB/Math/BaseCnv.pm'};
+ require 'Digest/MD5.pm' unless $INC{'Digest/MD5.pm'};
+ return &NB::Math::BaseCnv::cnv(substr(Digest::MD5::md5_hex(join(' ',@_)),1-1,12),16,10);
+}
+
+sub file_encoding {
+#------------------------------------------------------------------------------
+# NB 09.12.10
+#------------------------------------------------------------------------------
+my $file = shift;
+my $encoding = shift; # default value - NB 19.09.11
+
+ my $force = ($encoding||'') eq '_FORCE_';
+ $encoding = '' if $force;
+
+ return $encoding unless -e $file;
+
+ $_ = `file -ibz $file`;
+ my ($type,$charset) = (/^(.*?); .*?charset=(\S+)/) or return $encoding;
+
+ $charset = $1 if !$charset or $charset =~ /^us-ascii/
+ and `(izi-zcat $file | head -c 1000) 2>/dev/null` =~ /<\?xml[^>]+encoding="([^">]+)"/i;
+
+ return lc($1) if $charset =~ /^(iso-8859-\d+|UTF-\d+)/i;
+
+ return 'iso-8859-1' if $charset =~ /^iso-8859/i;
+
+ if ($force) {
+ my $tmp = "$TMP_DIR/file_encoding.$$.tmp";
+ system "izi-zcat $file 2>/dev/null | head -c 1000 > $tmp";
+
+ $encoding = &file_encoding($tmp);
+
+ unlink($tmp);
+ }
+
+ return $encoding;
+}
+
+sub http_logs_argv {
+#------------------------------------------------------------------------------
+# NB 09.12.10
+#------------------------------------------------------------------------------
+my @logs;
+local $_;
+
+ if (@ARGV and @logs = grep {-e $_ or $_ eq '-'} @ARGV) {
+
+ } else {
+
+ @logs = grep{$_} map{chomp($_);$_} `find /var/log/squid3/access*log 2>/dev/null` unless @logs;
+
+ @logs = grep{$_} map{chomp($_);$_} `find /var/log/apache2/access*log 2>/dev/null` unless @logs;
+
+ }
+
+ return @logs;
+
+}
+
+##############################################################################
+1;
+##############################################################################
projects / nb.git / commitdiff