From: Nicolas Boisselier Date: Tue, 7 Jul 2015 23:31:34 +0000 (+0100) Subject: profile, lib/perl X-Git-Url: https://git.nbdom.net/?a=commitdiff_plain;h=b7484920a631b1a8547233b4f35a12a069a0e3fa;p=nb.git profile, lib/perl --- diff --git a/bin/nb-install b/bin/nb-install index 1efe8fe7..e80c8e5b 100755 --- a/bin/nb-install +++ b/bin/nb-install @@ -63,19 +63,30 @@ fi echo "[ -r $NB_ROOT/etc/profile ] && . $NB_ROOT/etc/profile" > $TMP.profile if [ -d /etc/profile.d ]; then - if fdiff $TMP.profile /etc/profile.d/nb-profile.sh; then - verbose "Install /etc/profile.d/nb-profile.sh" - $INSTALL -c $TMP.profile /etc/profile.d/nb-profile.sh - chmod 755 /etc/profile.d/nb-profile.sh + rm -v /etc/profile.d/nb-profile.sh + + if fdiff $TMP.profile /etc/profile.d/nb.sh 1>/dev/null 2>&1; then + verbose "Install /etc/profile.d/nb.sh" + $INSTALL -c $TMP.profile /etc/profile.d/nb.sh + chmod 755 /etc/profile.d/nb.sh fi elif [ -w /etc/profile ]; then + grep -vF "$NB_ROOT/etc/profile.sh" /etc/profile > $TMP.clean + if fdiff /etc/profile $TMP.clean; then + verbose "Clean /etc/profile" + cat $TMP.clean > /etc/profile + fi + if ! grep -qm1 -F "$(cat $TMP.profile)" /etc/profile; then verbose "Install /etc/profile" cat $TMP.profile >> /etc/profile fi +else + echo "Can't install nb.sh" 1>&2 + fi # diff --git a/etc/bashrc b/etc/bashrc index abcfadba..2ef70944 100644 --- a/etc/bashrc +++ b/etc/bashrc @@ -3,12 +3,14 @@ # ENVS # ################################################################################# -. "${BASH_SOURCE%/*}/bashrc.function" +case "$BASH_SOURCE" in */*) path="${BASH_SOURCE%/*}";; *) path='.' ;; esac +. "$path/bashrc.function" +NB_ROOT=$(realpath ${path}/..) +unset path # # BASE # -NB_ROOT=$(realpath ${BASH_SOURCE%/*}/..) [ -z "$HOME" ] && HOME=`realpath ~/` [ -z "$HOSTNAME" ] && HOSTNAME=`hostname` [ -z "$UID" ] && UID=`id -u` @@ -18,7 +20,7 @@ NB_ROOT=$(realpath ${BASH_SOURCE%/*}/..) # # PATHS # -PATH=`nb_env_add_path "$PATH" \ +nb_env_add_path &>/dev/null && PATH=`nb_env_add_path "$PATH" \ /bin \ /sbin \ /usr/sbin \ @@ -37,10 +39,6 @@ PATH=`nb_env_add_path "$PATH" \ ` export PATH -export RUBYLIB=`nb_env_add_path "$RUBYLIB" $NB_ROOT/lib` -export PERL5LIB=`nb_env_add_path "$PERL5LIB" $NB_ROOT/lib` -export PYTHONPATH=`nb_env_add_path "$PYTHONPATH" $NB_ROOT/lib` - # # OTHERS # @@ -53,7 +51,7 @@ case "$OSTYPE" in darwin*) export DARWIN=1;; esac # # Color # -declare color_prompt color char h +color_prompt='' case "$TERM" in xterm-color) color_prompt=yes;; *screen*) color_prompt=yes;; @@ -64,6 +62,7 @@ esac # PS1 # h='\h' +color='' #case $(tr '[:upper:]' '[:lower:]' <<<"$HOSTNAME") in case "$HOSTNAME" in pi*) color=31 ;; @@ -77,18 +76,18 @@ case "$HOSTNAME" in esac char='$'; [ $UID = "0" ] && char='#' -if [ "$color_prompt" = yes ]; then +if [ "$color_prompt" = yes -a -n "$color" ]; then PS1="\[\033[01;${color}m\]\u@$h:\[\033[00m\]\W${char} " else PS1="\u@\h:\W${char} " fi +unset h color char # # ls # ls_opt='' ll_opt='' - if [ -n "$DARWIN" ]; then [ "$color_prompt" = yes ] && ls_opt="$ls_opt -G" else @@ -98,8 +97,9 @@ fi [ "$ls_opt" = "" ] || alias ls="ls${ls_opt}" alias ll="ls -alh${ll_opt}" +unset ls_opt ll_opt # # bye # -unset i color char color_prompt h ls_opt ll_opt +unset color_prompt diff --git a/etc/bashrc.function b/etc/bashrc.function index 7ac86ac3..5efd3a4b 100644 --- a/etc/bashrc.function +++ b/etc/bashrc.function @@ -5,8 +5,8 @@ ################################################################################# nb_env_add_path() { # Add paths to a variables - # Usage PATH=`sem-nb_env_add_path "$PATH" "/blbabla"` - declare env_value=$1; shift + # Usage PATH=`nb_env_add_path "$PATH" "/blbabla"` + declare env_value; env_value=$1; shift for p in $@; do [ -e "$p" ] || continue @@ -17,7 +17,7 @@ nb_env_add_path() { env_value="${p}${env_value}" done - echo "$env_value" + [ -z "$env_value" ] || echo "$env_value" } realpath() { @@ -143,7 +143,7 @@ if [ -n "$DARWIN" ]; then fi -nb-mails() { +nb_mails() { printf '| 1-$ cat\nx\n' | mail | perl -MDate::Manip -MEncode -ne ' BEGIN { $SIG{__WARN__} = sub{ } } $. == 2 and print; @@ -168,14 +168,14 @@ END { print map {sprintf "%20.20s | %16.16s | %s\n",@$_;} sort {$b->[1] cmp $a-> #printf 'f *\nx\n' | mail | perl -e '@_=<>; shift @_; print shift @_; print reverse @_' } -nb-git-create() { -# NB 19.02.15 root@pi:puppet# nb-git-create puppet/data +nb_git_create() { +# NB 19.02.15 root@pi:puppet# nb_git_create puppet/data # NB 19.02.15 Initialized empty Git repository in /home/git/puppet/data.git/ # NB 19.02.15 Cloning into 'data'... # NB 19.02.15 warning: You appear to have cloned an empty repository. # NB 19.02.15 Got to directory: data # NB 19.02.15 Reinitialized existing Git repository in /etc/puppet/data/.git/ -# NB 19.02.15 [master (root-commit) 3ea2a65] Created by nb-git-create +# NB 19.02.15 [master (root-commit) 3ea2a65] Created by nb_git_create # NB 19.02.15 1 file changed, 7 insertions(+) # NB 19.02.15 create mode 100644 README.md # NB 19.02.15 Counting objects: 3, done. @@ -224,7 +224,7 @@ DESCRIPTION git remote add origin $repo:${name}.git } -nb-git-clone() { +nb_git_clone() { git clone git@git.nbdom.net:${1%.git}.git } @@ -248,11 +248,11 @@ puppet-upgrade-modules() { cd $pwd } -nb-rb() { +nb_rb() { ruby -r/etc/puppet/modules/nb/lib/nb.rb -e "$@" } -nb-hl() { +nb_hl() { cat | grep --color=auto -E "(^|($@))" } @@ -270,7 +270,7 @@ find-sort-mtime() { ) | sort -k1 -n | cut -f 2 | head } -nb-alert() { +nb_alert() { local cmd=". $NB_ROOT/etc/profile" local host=macbook.brighton.loc case "$1" in @@ -302,7 +302,7 @@ nb-alert() { local ip=`dig +short $host` [ -z "$ip" ] && echo "Can't resolve macbook.brighton.loc" && return 1 - nb-ips | grep -qFm1 "$ip" || cmd="ssh -o BatchMode=yes $host -- $cmd" + nb_ips | grep -qFm1 "$ip" || cmd="ssh -o BatchMode=yes $host -- $cmd" #[ "$USER" != "nico" ] && cmd="su - nico -c '$cmd'" [ "$USER" != "nico" ] && cmd="sudo -u nico -- $cmd" @@ -314,11 +314,11 @@ nb-alert() { eval "$cmd" } -nb-ips() { +nb_ips() { ifconfig | perl -ne '/^\s*inet (?:addr:)?([\d\.]+)/ and $1 ne "127.0.0.1" and print "$1\n"' } -nb-radio-play() { +nb_radio_play() { local radios="\ 1 | FranceInter | http://www.tv-radio.com/station/france_inter_mp3/france_inter_mp3-128k.m3u 2 | Indie | http://107.155.126.42:17160/listen.pls @@ -337,20 +337,20 @@ Choose one > \ awk -F '|' '$1 == '$REPLY' {print $3; exit}' <<< "$radios" | sed 's/^ //' | xargs mplayer 2>/dev/null } -# NB 06.07.15 alias nb-img2jpg='convert -strip -interlace Plane -gaussian-blur 0.05 -quality 85%' +# NB 06.07.15 alias nb_img2jpg='convert -strip -interlace Plane -gaussian-blur 0.05 -quality 85%' # NB 06.07.15 -# NB 06.07.15 nb-img-compress() { +# NB 06.07.15 nb_img_compress() { # NB 06.07.15 local IFS=$'\n' i='' j='' # NB 06.07.15 for i in $@; do # NB 06.07.15 [ -e "$i" ] || continue # NB 06.07.15 j="${i%.*}.jpg" # NB 06.07.15 echo "$i -> $j" -# NB 06.07.15 nb-img2jpg $i $j || continue +# NB 06.07.15 nb_img2jpg $i $j || continue # NB 06.07.15 [ "$i" != "$j" ] && rm "$i" # NB 06.07.15 done # NB 06.07.15 } # NB 06.07.15 -# NB 06.07.15 nb-img-compress-gray() { +# NB 06.07.15 nb_img_compress_gray() { # NB 06.07.15 # See: http://www.imagemagick.org/script/command-line-options.php#colorspace # NB 06.07.15 # See: convert -list colorspace # NB 06.07.15 local IFS=$'\n' i='' j='' @@ -358,7 +358,7 @@ Choose one > \ # NB 06.07.15 [ -e "$i" ] || continue # NB 06.07.15 j="${i%.*}.jpg" # NB 06.07.15 echo "$i -> $j" -# NB 06.07.15 nb-img2jpg -colorspace Gray -normalize -level 10%,90% -sharpen 0x1 $i $j || continue +# NB 06.07.15 nb_img2jpg -colorspace Gray -normalize -level 10%,90% -sharpen 0x1 $i $j || continue # NB 06.07.15 [ "$i" != "$j" ] && rm "$i" # NB 06.07.15 done # NB 06.07.15 } diff --git a/etc/profile b/etc/profile index 371345a0..4aca4d5a 100644 --- a/etc/profile +++ b/etc/profile @@ -1,10 +1,10 @@ -#case "$SHELL" in */zsh) BASH_SOURCE=${(%):-%N} ;; esac -[ -r "${BASH_SOURCE%/*}/bashrc" ] && . "${BASH_SOURCE%/*}/bashrc" -[ -r "${BASH_SOURCE%/*}/aliases" ] && . "${BASH_SOURCE%/*}/aliases" +case "$BASH_SOURCE" in */*) path="${BASH_SOURCE%/*}";; *) path='.' ;; esac +[ -r "${path}/bashrc" ] && . "${path}/bashrc" +[ -r "${path}/aliases" ] && . "${path}/aliases" -for i in ${BASH_SOURCE%/*}/profile.d/*.sh; do +for i in $NB_ROOT/etc/profile.d/*.sh; do [ -r "$i" ] && . "$i" done -unset i +unset i path true diff --git a/etc/profile.d/lib.sh b/etc/profile.d/lib.sh new file mode 100644 index 00000000..679a7f36 --- /dev/null +++ b/etc/profile.d/lib.sh @@ -0,0 +1,3 @@ +export PERL5LIB=`nb_env_add_path "$PERL5LIB" "$NB_ROOT/lib/perl"` +export RUBYLIB=`nb_env_add_path "$RUBYLIB" "$NB_ROOT/lib/ruby|"` +export PYTHONPATH=`nb_env_add_path "$PYTHONPATH" "$NB_ROOT/lib/python"` diff --git a/etc/profile.d/zsh.sh b/etc/profile.d/zsh.sh new file mode 100644 index 00000000..50a1417d --- /dev/null +++ b/etc/profile.d/zsh.sh @@ -0,0 +1 @@ +#case "$SHELL" in */zsh) BASH_SOURCE=${(%):-%N} ;; esac diff --git a/lib/perl/NB.pm b/lib/perl/NB.pm new file mode 100644 index 00000000..3826bf92 --- /dev/null +++ b/lib/perl/NB.pm @@ -0,0 +1,21 @@ +package NB; +use strict; +use warnings; +use NB::Functions qw/:all/; +BEGIN { + use Exporter(); + our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); + $VERSION = 1.00; + @ISA = qw(Exporter); + @EXPORT_OK = @NB::Functions::EXPORT_OK; + @EXPORT = @NB::Functions::EXPORT_OK; + %EXPORT_TAGS = ( + #'all' => [@EXPORT_OK] + ); # eg: TAG => [ qw!name1 name2! ], + + # your exported package globals go here, + # as well as any optionally exported functions +} +our @EXPORT_OK; + +1; # don't forget to return a true value from the file diff --git a/lib/perl/NB/Functions.pm b/lib/perl/NB/Functions.pm new file mode 100644 index 00000000..9d461240 --- /dev/null +++ b/lib/perl/NB/Functions.pm @@ -0,0 +1,1278 @@ +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($_ = ) 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#(?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; +##############################################################################