my scripts: 2011

вторник, 13 декабря 2011 г.

Java development 2.0:
Часть 1. Вторая волна разработки Java-приложений: «Облачное» хранилище средствами Amazon SimpleDB
Часть 2. Вторая волна разработки Java-приложений: «Облачное» хранилище средствами Amazon SimpleDB
http://www.ibm.com/developerworks/ru/library/j-javadev2-9/index.html?ca=dre-
http://www.ibm.com/developerworks/ru/library/j-javadev2-10/index.html?ca=dre-

понедельник, 28 ноября 2011 г.

3 варианта подключения файла в перле

На примере сапы
my $sape_id = 'aaaaaa';
1) require sprintf('%s/%s/SAPE.pm', $ENV{'DOCUMENT_ROOT'}, $sape_id);
2) require "$ENV{DOCUMENT_ROOT}/${sape_id}/SAPE.pm";
3) "$ENV{DOCUMENT_ROOT}/aaaaaaa/SAPE.pm" =~ /^(.+)$/; require $1;

Как мне кажется, 2 метод оптимальный. Вопрос, как там со всякими null-byte уязвимостями.

среда, 23 ноября 2011 г.

Особенности подключения модулей и сообщений об ошибках

Переносили сайт.
Проблема возникла с TrustLink:

/var/www/site/htroot/ffffff at (eval 12) line 13.
{
{
        'ffffff';

        push @INC, "$ENV{DOCUMENT_ROOT}/$o->{TRUSTLINK_USER}";
->      eval("use TrustlinkClient;") or die $!;
        my $trustlink = new TrustlinkClient($o);
        undef($o);
#       use Data::Dumper;
#       print '<pre>',Dumper($trustlink),'</pre>';

        print $trustlink->build_links();
}

Права в порядке. Добавили перед евалом

warn join ("\n", @INC);

Вывод нормальный, аномалий нет, путь к нужному модулю есть.
Вставили вместо евала прямое подключение

require "$ENV{DOCUMENT_ROOT}/ffffff/TrustlinkClient.pm";

Оказалось, он не модуль не видит, а в модуле ошибка - нет библиотеки URI. Проблема была решена установкой libwww-perl
Так из-за абсолютно невменяемого показа ошибок диагностика заняла 3 часа.

суббота, 15 октября 2011 г.

dive into python

Похоже, основной сайт закрылся, но осталась куча зеркал

(англ) (рус)

суббота, 24 сентября 2011 г.

bitrix backup script


#!/bin/sh
#http://dev.1c-bitrix.ru/community/blogs/howto/945.php

doc_root=$1
name=$2
if [ -z $doc_root ]; then
    echo Usage: $0 /path/to/document/root [backup_name]
    exit
fi

if [ -z $name ]; then
    name=backup
fi

dbconn=$doc_root/bitrix/php_interface/dbconn.php

readcfg() {
    grep $1 $dbconn | sed 's/.*"\(.*\)".*/\1/'
}

host=`readcfg DBHost`
username=`readcfg DBLogin`
password=`readcfg DBPassword`
database=`readcfg DBName`

utf=`grep 'BX_UTF' $dbconn | grep true`

if [ -z "$utf" ]; then
    charset=cp1251
    else
    charset=utf8
fi

backup_dir=$doc_root/bitrix/backup

if [ ! -e $backup_dir ]; then
    mkdir $backup_dir
fi

cd $doc_root && 
mysqldump -h$host -u$username -p$password --default-character-set=$charset $database > $backup_dir/$name.sql && 
tar -cf $backup_dir/$name.tar $backup_dir/$name.sql &&  
rm $backup_dir/$name.sql &&
tar -rf $backup_dir/$name.tar --exclude '*bitrix/tmp/*' --exclude '*bitrix/updates/*' --exclude '*bitrix/backup/*' --exclude '*bitrix/*cache/*' . && 
gzip -f -9 $backup_dir/$name.tar && 
echo OK && exit
echo Error

вторник, 20 сентября 2011 г.

perl: профилирование

Вариантов много.
perl -d:NYTProf script.pl
nytprofhtml && смотрим в браузере

perl-Class-Accessor-Named.noarch : Better profiling output for Class::Accessor
perl-Devel-Profiler.noarch : Perl profiler compatible with dprofpp
perl-Template-Timer.noarch : Rudimentary profiling for Template Toolkit
perl-Test-Timestamp.noarch : Create timestamp objects for testing or profiling
perl-Devel-NYTProf.x86_64 : Powerful fast feature-rich perl source code profiler
perl-Devel-SmallProf.noarch : Per-line Perl profiler
perl-Template-Timer.noarch : Rudimentary profiling for Template Toolkit

oprofile.x86_64 : System wide profiler

понедельник, 12 сентября 2011 г.

Обрывки мыслей: Работа с UTF-8 в Perl

Обрывки мыслей: Работа с UTF-8 в Perl: afiskon: use utf8; потом utf8::encode($str) или utf8::decode($str) одна приобразует из перлового представления в utf8, вторая - обратно. как...

четверг, 8 сентября 2011 г.

Получение заголовков, в частности показ сжатия

#!/usr/local/bin/python

#http://diveintopython.org/http_web_services/gzip_compression.html

import urllib2, httplib
import sys
#httplib.HTTPConnection.debuglevel = 1
if (len(sys.argv)<2):
print 'Use: '+sys.argv[0]+' site.ru/index.html'
exit(1)
host = 'http://'+sys.argv[1]
request = urllib2.Request(host)
request.add_header('Accept-encoding', 'gzip')
opener = urllib2.build_opener()
f = opener.open(request)
print(f.headers)
f.close()

среда, 17 августа 2011 г.

module trim

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}

sub ltrim($)
{
my $string = shift;
$string =~ s/^\s+//;
return $string;
}

sub rtrim($)
{
my $string = shift;
$string =~ s/\s+$//;
return $string;
}

parse liveinternet.ru

#!/usr/bin/perl

use IO::File;

$inputfn=(($ARGV[0] ne '')?$ARGV[0]:"hosts.txt");
print "Parsing file: $inputfn\n";

#GET "http://www.liveinternet.ru/stat/site.ru/index.html?period=month;total=yes" | grep -A 1 id_8 | tail -1 | perl -e '<>=~/\>(\d+)\</;print $1;print "\n";'

#counter end
$ce=(($ARGV[1] ne '')?$ARGV[1]:"0");
my $c = 0;

open(F, $inputfn) or die $!;

while ($a=<F>)
{
        $a = trim ($a);

        if ($a ne "")
        {

                $req='GET "http://www.liveinternet.ru/stat/';
                $req.=$a;
                $req.='/index.html?period=month;total=yes" | grep -A 2 id_8 | tail -1';
#print ($req);
                $str=`$req`;
                $str=~m/\>([\d.,]+)\0 && $c >= $ce);
}

close F;

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
        my $string = shift;
        $string =~ s/^\s+//;
        $string =~ s/\s+$//;
        return $string;
}

split access_log by months

#!/usr/bin/perl

my $in = @ARGV[0];
open (IN, $in);

my $f = '';

while (my $str = )
{
$str =~ m#\[(\d{2})/(\w{3})/(\d{4}):.*]#;
#print "$3$2 $str \n";
my $cur = "$3$2";
if ( $cur ne $f)
{
if ($f ne '') {close OUT;}

$f = $cur;
open (OUT, "> $f-$in");
print "$f-$in\n";
}

print OUT $str;
}

close IN;
close OUT;
#return 0;
exit 0;

#in: parse.pl access_log
#out: 2011Feb-access_log, ...

sendsms

#!/usr/bin/perl
#use diagnostics;
#use strict;
#use Getopt::Std;

use vars qw/ %opt /;
use Getopt::Std;
use URI::Escape;

%group = {
admins => (
"7921xxxxxxx",
"123"
),
all => (
"987",
"654"
)
};

$login='login';
$pass='pass';
$gate='1cgw.streamsms.ru';
$from='web';

sub Send
{
# print @_;
my @list=@_;
foreach $list (@list)
{
$cmd="GET \"http://$gate/sendsms.php?user=$login&pwd=$pass&sadr=$from&dadr=$list&text=$msg\"";
# $out=$cmd;
# $out=`$cmd`;
if ($opt_v==1 || $opt_d==1) { print $cmd."\n";}
if ($opt_d==1) { next; }
$out=`$cmd`;
if ($opt_v==1) { print $out."\n";}
}
}

sub usage
{
print STDERR << "EOF"; usage: $0 [-h] [-v|-d] [-g group|-n number] text of sms -h :help -v : verbose -f : from -g : group (from code), mb admins -n : phone number, 11 digits (7921xxxxxxx), without + -d : dumb mode - only show EOF exit; } if ($#ARGV<1) { #exit ("see usage"); usage(); exit(); } @admin = ('7921xxxxxxx'); @admins = ('7921xxxxxxx','7921yyyyyyy'); @test = ('123','456'); getopts ('dhvf:g:n:') ;# or usage(); usage() if $opt_h; #$msg = join (" ", @ARGV); #print %opt; $msg = uri_escape(join (" ", @ARGV)); if (length($opt_f)>0)
{
$from=$opt_f;
}

if (length($opt_g)>0)
{
#Send($group{$opt_g}); #@admins);
Send(@admins);

}

if (length($opt_n)>0)
{
Send($opt_n);
}

вторник, 13 декабря 2011 г.

понедельник, 28 ноября 2011 г.

среда, 23 ноября 2011 г.

суббота, 15 октября 2011 г.

суббота, 24 сентября 2011 г.

вторник, 20 сентября 2011 г.

понедельник, 12 сентября 2011 г.

четверг, 8 сентября 2011 г.

среда, 17 августа 2011 г.