end0tknr's kipple - web写経開発

太宰府天満宮の狛犬って、妙にカワイイ

Date::Calc for perl で、GMT <-> Localtime 変換

こんな感じかな?

#!/usr/local/bin/perl
use strict;
use warnings;
use utf8;
use Date::Calc;
use Data::Dumper;

main(@ARGV);

# http://search.cpan.org/perldoc?Date%3A%3ACalc

sub main {

    gmt_to_local();
    local_to_gmt();
}

sub gmt_to_local {

    my $is_gmt = 1;
    my @now = Date::Calc::Today_and_Now($is_gmt);
    my @tzone = Date::Calc::Timezone();
    my @now_2 = Date::Calc::Add_Delta_YMDHMS(@now[0..5], @tzone[0..5]);

    print "GMT->LOCAL : ";
    print sprintf("%04d-%02d-%02d %02d:%02d:%02d",@now);
    print " -> ";
    print sprintf("%04d-%02d-%02d %02d:%02d:%02d",@now_2),"\n\n";
}

sub local_to_gmt {

    my @now = Date::Calc::Today_and_Now();
    my @tzone = Date::Calc::Timezone();
    my @now_2 = Date::Calc::Add_Delta_YMDHMS(@now[0..5],
                                             $tzone[0] * -1,
                                             $tzone[1] * -1,
                                             $tzone[2] * -1,
                                             $tzone[3] * -1,
                                             $tzone[4] * -1,
                                             $tzone[5] * -1);
    print "LOCAL->GMT : ";
    print sprintf("%04d-%02d-%02d %02d:%02d:%02d",@now);
    print " -> ";
    print sprintf("%04d-%02d-%02d %02d:%02d:%02d",@now_2),"\n";
}

perlの日付&時間計算module (Date::Calc , DateTime)の比較

perlの日付&時間計算module (Date::Calc , DateTime)の比較

http://search.cpan.org/dist/Date-Calc/ http://search.cpan.org/dist/DateTime/

主に Date::Calc を使っていますが、本日時点(2016/11/14)で、自分が気になるポイントを比較しています。

2016/11/14時点 Date::Calc DateTime
最新VER 6.4 1.4
最終更新 2015/3 2016/11
Rating 3.5 4.5
日付チェック check_date($y,$m,$d) DateTime->new(...) が失敗
現在日時 @ymd_hms=Today_and_Now() $dt_obj=DateTime->now()
日付の差分 $days=Delta_Days(@ymd1,@ymd2) $dlt_dt=$dt1->delta_days( $dt2 ); $dlt_dt->days;
?日後 @ymd=Add_Delta_YMD(@ymd, @dlt_ymd) $dt_2=$dt->add(months=>2, days=>3);
月の日数 $days = Days_in_Month($y,$m) $dt_obj=DateTime->last_day_of_month(year=>2008,month=>2); $dt_obj->day;

DateTimeは現在も定期的?にメンテされているので、移行しようかとも思いましたが、私が普段行っている日付計算程度であれば、Date::Calcのstaticコマンドで十分...

s3cmd 経由による javascript (ajax)で利用できる簡易なs3 web api

が欲しくなったので、メモ。

s3cmd で、テキストやbase64な画像ファイルをput/get な感じです

s3 ...というより IAM( Identity and Access Management ) の設定

以下の3つのポリシーを作成し、利用するユーザ等にアタッチさせます。

1番目の全バケット(*)に対する ListAllMyBuckets は、s3cmdが設定を行う為に必要です。 2,3番目で test-foo-backet に限定してますので、s3cmdが他のbacketに悪影響を及ぼすことはなさそうです。

Effect: Allow
AWS Service: Amazon S3
Actions: ListAllMyBuckets
Amazon Resource Name(ARN): arn:aws:s3:::*

Effect: Allow
AWS Service: Amazon S3
Actions: All Actions Selected
Amazon Resource Name(ARN): arn:aws:s3:::test-foo-backet

Effect: Allow
AWS Service: Amazon S3
Actions: All Actions Selected
Amazon Resource Name(ARN): arn:aws:s3:::test-foo-backet/*

s3cmd の準備 (install & configure)

# yum -y --enablerepo epel install s3cmd
$ s3cmd --configure

「s3cmd --configure」では、Access Key や Secret Key の入力を求められますが、 これらは、AWSマネージメントコンソールの IAM > ユーザ > アクセスキーの管理 で、発行して下さい。(ただ...アクセスキーは、2個/ユーザまでです)

ここから先はsrcを貼ります

development.pl

use File::Spec;
use File::Basename qw(dirname);
my $basedir = File::Spec->rel2abs(File::Spec->catdir(dirname(__FILE__), '..'));
my $dbpath = File::Spec->catfile($basedir, 'db', 'development.db');
+{
  aws_s3 =>
  {content_backet=>'test-backet',
   s3cmd =>'/usr/bin/s3cmd',
   s3cmd_conf =>'/home/endo/.s3cfg',
   backet_cache_dir =>'/home/endo/dev_data/TestAmon2/backet_cache',
  }
};

html template

: cascade "include/Layout.html"

: override head_content -> {
<title>AWS S3 API</title>
: }

: override body_main_content -> {
  <form id="main_form" method="post">
    BASE FOLDER<input type="text" id="base_folder" value="testfolder">
    ユーザID   <input type="text" id="uid"         value="xxx7654321">
    <hr>
    <input type="text" id="form_1" value="HOGE1">
    <input type="text" id="form_2" value="ほげ2">

    <button type="button" onClick="aws_s3.save_txt_data()">UPLOAD TXT</button>
    <button type="button" onClick="aws_s3.load_txt_data()">DOWNLOAD TXT</button>
    <button type="button" onClick="aws_s3.ls_data()"      >LISTING DATA(ls)</button>
    <hr>

    <input type="file" id="file_1" style="display:inline; width:350px;">

    <button type="button" onClick="aws_s3.chk_image()">CHECK IMAGE</button>
    <button type="button" onClick="aws_s3.save_image()">UPLOAD IMAGE</button>
    <button type="button" onClick="aws_s3.load_image()">DOWNLOAD IMAGE</button>
    <table class="table table-bordered">
      <tbody>
    <tr>
      <th style="width:100px;">file名</th>
      <td style="width:150px;"id="file_name"></td>
      <th style="width:100px;">mime type</th>
      <td style="width:150px;" id="file_type"></td>
      <th style="width:150px;">file size (byte)</th>
      <td style="width:150px;" id="file_size"></td>
    </tr>
      </tbody>
    </table>
    <img id="thumb_nail" width="400">
    <div id="img_test"></div>

  </form>
: }


: override body_sub_content -> {
: }

: override foot_content -> {
<script src="/static/js/jquery.cookie.js"></script>
<script src="/static/js/aws_s3_api.js"></script>
<script>
 $(document).ready(function(){
   aws_s3.set_base_folder( $('#base_folder').val() );
 });
</script>
: }

javascript

(function() {
    var AwsS3Api = function(){};
    
    AwsS3Api.prototype = {

        chk_image: function(){
            if(! window.File || ! window.FileReader) {
                alert("このブラウザはFile APIをサポートしていません");
                return;
            }
        // jQueryオブジェクトから、元のhtmlオブジェクトを抽出
            var file = $('#file_1').get(0).files[0];
            if(! file || ! file.type.match(/image/)) {
                alert('画像ファイルを選択下さい');
                return;
            }
            $('#file_name').html( file.name );
            $('#file_type').html( file.type );
            $('#file_size').html( file.size );

            var reader = new FileReader();
            var this_obj = this;
            reader.onload = function(evt) {
                $("#thumb_nail").attr('src',reader.result);
                $("#thumb_nail").css('display','block');
            };
            reader.readAsDataURL(file);

        },
        
        save_image : function (){
            var mime_type = $('#file_type').text().split('/');
            if( mime_type[0] != 'image'){
                alert('画像ファイルを選択下さい');
                return;
            }
            
            var data = { 'XSRF-TOKEN': $.cookie('XSRF-TOKEN') };
            var this_obj = this;
            var uid = $('#uid').val();
            var filename = uid + "_base64_image.txt";
            var path =
                [this.base_folder, this.calc_user_path( uid ), filename].join('/');
            var url = '/awss3/put/' + path;

            data.content = $("#thumb_nail").attr('src');

            $.ajax({url: url,
                    type: 'POST',
                    data: data,
                    success: function(data,txt_status,xhr){
                        if(data.result != 'OK'){
                            alert('処理が失敗しました');
                            return;
                        }
                        alert('処理が完了しました');
                    },
                    error: function(data,txt_status,xhr){
                        alert('処理が失敗しました');
                    }
                   });
        },

        load_image : function (){
            var data = { 'XSRF-TOKEN': $.cookie('XSRF-TOKEN') };
            var this_obj = this;

            var uid = $('#uid').val();
            var filename = uid + "_base64_image.txt";
            var path =
                [this.base_folder, this.calc_user_path( uid ), filename].join('/');
            var url = '/awss3/get/' + path;

            $.ajax({url: url,
                    type: 'POST',
                    data: data,
                    success: function(data,txt_status,xhr){
                        if(data.result != 'OK'){
                            alert('処理が失敗しました');
                            return;
                        }
                        $("#thumb_nail").attr('src', data.content);
                        alert('処理が完了しました');
                    },
                    error: function(data,txt_status,xhr){
                        alert('処理が失敗しました');
                    }
                   });
        },

        set_base_folder: function(base_folder){
            this.base_folder = base_folder;
        },

    //複数ユーザのファイルを1個のdirに登録すると、lsがスゴそうですので...
        calc_user_path: function( uid ){
            //ex. uid = uid123456 + chk digit
            var m = uid.match(/^(uid\d\d\d)\d\d\d/i);
            if( m[1] ){
                return m[1].toLowerCase();
            }
            return 'other';
        },

        save_txt_data : function (){
            var data = { 'XSRF-TOKEN': $.cookie('XSRF-TOKEN') };
            var this_obj = this;

            var uid = $('#uid').val();
            var filename = uid + "_answer.txt";
            var path =
                [this.base_folder, this.calc_user_path( uid ), filename].join('/');
            var url = '/awss3/put/' + path;
            data.content = [ $('#form_1').val().replace(/\t/g, ' '),
                             $('#form_2').val().replace(/\t/g, ' ')].join("\t");
            $.ajax({url: url,
                    type: 'POST',
                    data: data,
                    success: function(data,txt_status,xhr){
                        if(data.result != 'OK'){
                            alert('処理が失敗しました');
                            return;
                        }
                        alert('処理が完了しました');
                    },
                    error: function(data,txt_status,xhr){
                        alert('処理が失敗しました');
                    }
                   });
        },

        load_txt_data : function (){
            var data = { 'XSRF-TOKEN': $.cookie('XSRF-TOKEN') };
            var this_obj = this;

            var uid = $('#uid').val();
            var filename = uid + "_answer.txt";
            var path =
                [this.base_folder, this.calc_user_path( uid ), filename].join('/');
            var url = '/awss3/get/' + path;

            $.ajax({url: url,
                    type: 'POST',
                    data: data,
                    success: function(data,txt_status,xhr){
                        if(data.result != 'OK'){
                            alert('処理が失敗しました');
                            return;
                        }

                        var cols = data.content.split("\t");

                        $('#form_1').val(cols[0]);
                        $('#form_2').val(cols[1]);

                        alert('処理が完了しました');
                    },
                    error: function(data,txt_status,xhr){
                        alert('処理が失敗しました');
                    }
                   });
        },
        
        ls_data : function (){
            var data = { 'XSRF-TOKEN': $.cookie('XSRF-TOKEN') };
            var this_obj = this;

            var uid = $('#uid').val();
            var filename = uid + "_answer.txt";
            var path =
                [this.base_folder, this.calc_user_path( uid ), filename].join('/');
            var url = '/awss3/ls/' + path;

            $.ajax({url: url,
                    type: 'POST',
                    data: data,
                    success: function(data,txt_status,xhr){
                        if(data.result != 'OK'){
                            alert('処理が失敗しました');
                            return;
                        }

                        alert( data.content );
                    },
                    error: function(data,txt_status,xhr){
                        alert('処理が失敗しました');
                    }
                   });
        }
    };
    window.aws_s3 = new AwsS3Api();
})();

Controller (perl)

package TestAmon2::Web::Dispatcher::AwsS3Api;
use strict;
use utf8;
use base qw/TestAmon2::Web::Dispatcher/;
use Data::Dumper;       # for debug write
use TestAmon2::Model;
use TestAmon2::Web::View;


sub new {
    my ($class) = @_;
    my $self = {};
    $self =  bless $self, $class;
    return $self;
}

sub do_main {
    my ($self,$c) = @_;

    $self->{c} = $c;
    $self->{user_id} = $self->get_login_user_id($c);
    my $path_info_str = $c->req()->{env}->{PATH_INFO};

    unless( $path_info_str =~ m{^/awss3/([^/]+)/(.*)}o ){
        return $self->do_index_page($c);
    }
    my $action =  $1;
    my $s3_path = $2;

    if($action eq 'ls' or
       $action eq 'get' or
       $action eq 'put'
      ){
        my $method = "do_".$action;
        return $self->$method($c, $s3_path);
    }

    return $self->do_index_page($c);
}

sub do_index_page {
    my ($self, $c) = @_;

    my $render_data = {};
    $render_data->{c} = $c;
    my $view = TestAmon2::Web::View::AwsS3Api->new();

    return $view->render_index_page($c, $render_data);
}

sub do_put {
    my ($self, $c,$s3_path) = @_;

    my $render_data = {};
    $render_data->{c} = $c;
    my $view = TestAmon2::Web::View::AwsS3Api->new();

    my $m_aws_s3 = TestAmon2::Model::AwsS3->new($c);

    my $result = $m_aws_s3->cmd_put($s3_path,
                                    $c->req->param('content'));
    if ($result){
        return $c->render_json( {result=>'OK'});
    }
    return $c->render_json( {result=>'NG'});
}

sub do_get {
    my ($self, $c,$s3_path) = @_;

    my $render_data = {};
    $render_data->{c} = $c;
    my $view = TestAmon2::Web::View::AwsS3Api->new();

    my $m_aws_s3 = TestAmon2::Model::AwsS3->new($c);
    $render_data->{content} = $m_aws_s3->cmd_get($s3_path);

    if(not defined($render_data->{content})){
        return $c->render_json( {result=>'NG'});
    }
    return $c->render_json({result=>'OK',
                            content=> $render_data->{content}});
}

sub do_ls {
    my ($self, $c,$s3_path) = @_;

    my $render_data = {};
    $render_data->{c} = $c;
    my $view = TestAmon2::Web::View::AwsS3Api->new();

    my $m_aws_s3 = TestAmon2::Model::AwsS3->new($c);
    $render_data->{content} = $m_aws_s3->cmd_ls($s3_path);

    if(not defined($render_data->{content})){
        return $c->render_json( {result=>'NG'});
    }
    return $c->render_json({result=>'OK',
                            content=> $render_data->{content}});
}

1;
__END__

Model (perl)

s3に対するput/getは遅いので、ec2側にもcacheしています

package TestAmon2::Model::AwsS3;
use strict;
use utf8;
use base qw/TestAmon2/;
use Cwd;
use File::Path qw/mkpath rmtree/;
use File::Temp;
use MIME::Base64;
use Data::Dumper;       # for debug write

my $CONF = TestAmon2->config;
my $S3CMD = $CONF->{aws_s3}->{s3cmd};
my $S3CMD_CONF = $CONF->{aws_s3}->{s3cmd_conf};
my $BACKET = $CONF->{aws_s3}->{content_backet};
my $CACHE_LIMIT_AGE = 60 * 5; #sec


# http://*.com/awss3/get $BACKET/$FOLDER/$FILE
# s3cmd ls s3://バケット名
# s3cmd put オブジェクト名 s3://バケット名/
# s3cmd get オブジェクト名 s3://バケット名/
# s3cmd del オブジェクト名 s3://バケット名/

sub new {
    my ($class, $c) = @_;

    my $self = {c=>$c};
    $self =  bless $self, $class;
    return $self;
}

sub open_localfile {
    my ($self, $path ) = @_;

    my $fh;
    unless( open($fh, '<', $path) ){
        $self->log_error("fail open $path");
        return;
    }

    local $/ = undef;
    my $content = <$fh>;

    unless( close($fh) ){
        $self->log_error("fail close $path");
        return;
    }
    
    if($path =~ /\.txt$/io ){
        $content = Encode::decode('utf8',$content);
    } else {
        $content = MIME::Base64::encode_base64($content);
    }
    
    return $content;
}


sub cmd_put {
    my ($self, $path, $content ) = @_;

    unless( $path =~ m|^(.+)/([^/]+)$|o){
        $self->log_error("fail parse dir/filename from $path");
        return;
    }
    my $parent_dir = $1;
    my $filename =   $2;

    my $cache_dir = join('/',$CONF->{aws_s3}->{backet_cache_dir},$parent_dir);
    my $cache_path = "$cache_dir/$filename";

    if(not -d $cache_dir){
        unless( File::Path::mkpath($cache_dir)) {
            $self->log_error("fail mkpath $cache_dir");
            return;
        }
    }

    my $fh;
    unless( open($fh, '>', $cache_path) ){
        $self->log_error("fail open $cache_path");
        return;
    }
    print $fh Encode::encode('utf8', $content);

    unless( close($fh) ){
        $self->log_error("fail close $cache_path");
        return;
    }

    my $cmd = join(' ',
                   "$S3CMD --quiet --force --config=$S3CMD_CONF",
                   "put $cache_path s3://$BACKET/$parent_dir/");
    unless( open($fh, '-|', $cmd) ){
        $self->log_error("fail open $cmd");
        return;
    }

    unless( close($fh) ){
        $self->log_error("fail close $cmd");
        return;
    }

    return $path;
}

sub cmd_get {
    my ($self, $path ) = @_;

    unless( $path =~ m|^(.+)/([^/]+)$|o){
        $self->log_error("fail parse dir/filename from $path");
        return;
    }
    my $parent_dir = $1;
    my $filename =   $2;

    my $cache_dir = join('/',$CONF->{aws_s3}->{backet_cache_dir},$parent_dir);
    my $cache_path = "$cache_dir/$filename";

    if(-e $cache_path ){
        my $now =   time();
        my $mtime = (stat($cache_path))[9];
        if(($now - $mtime) < $CACHE_LIMIT_AGE ){
            return $self->open_localfile($cache_path);
        }
    }

    if(not -d $cache_dir){
        unless( File::Path::mkpath($cache_dir)) {
            $self->log_error("fail mkpath $cache_dir");
            return;
        }
    }

    my $cmd = join(' ',
                   "$S3CMD --quiet --force --config=$S3CMD_CONF",
                   "get s3://$BACKET/$path $cache_dir/");
    my $fh;
    unless( open($fh, '-|', $cmd) ){
        $self->log_error("fail open $cmd");
        return;
    }

    unless( close($fh) ){
        $self->log_error("fail close $cmd");
        return;
    }

    unless(utime(undef,undef,$cache_path)){
        $self->log_error("fail utime(touch command) $cache_path");
        return;
    }

    return $self->open_localfile($cache_path);
}

sub cmd_ls {
    my ($self, $path ) = @_;

    my $cmd = join(' ',"$S3CMD --config=$S3CMD_CONF","ls s3://$BACKET/$path");
    my $fh;
    unless( open($fh, '-|', $cmd) ){
        $self->log_error("fail open $cmd");
        return [];
    }

    my @ret;
    while(my $line = <$fh>){
        chomp($line);
        my @cols = split(/\s\s+/, $line);

        $cols[2] =~ s|s3://$BACKET/||o;
        if( $cols[1] eq 'DIR'){
            push(@ret,[$cols[2]]);
        } else {
            push(@ret,[$cols[2],$cols[1],$cols[0]]);
        }
    }
    
    unless( close($fh) ){
        $self->log_error("fail close $cmd");
        return [];
    }
    return \@ret;
}

1;
__END__

View (perl)

package TestAmon2::Web::View::AwsS3Api;
use strict;
use utf8;
use base qw(TestAmon2::Web::View);
use Data::Dumper;       # for debug write

sub new {
    my ($class) = @_;
    my $self = {};
    $self =  bless $self, $class;
    return $self;
}

sub render_ls {
    my ($self, $c, $render_data) = @_;
    return $c->render_json( {body=>$render_data->{paths}});
}

sub render_get {
    my ($self, $c, $render_data) = @_;
    return $c->render_json( {body=>$render_data->{content}});
}

sub render_index_page {
    my ($self, $c, $render_data) = @_;
    return $c->render('AwsS3Api/Index.html', $render_data);
}

1;
__END__

最尤推定 (さいゆうすいてい) - もっともらしい母比率を求める

サイコロの偶数が6回中、2回出るときの母比率(1回当たりの偶数が出る確立)?

例として、母比率=0.5の場合、6回中、2回、偶数が出る確立を求めます。

 \Large {}_6 C_2 0.5^2 (1-0.5)^4
= \Large \frac {6!}{2!(6-2)!} 0.5^6
= \Large 15 0.5^6
 \Large ≒ 15 0.015625 ≒ 0.2343

同様に母比率=0.2, 0.3 , 0.4 , 0.8 の場合を求めます。

 \Large {}_6 C_2 0.2^2 (1-0.2)^4
= \Large 15  0.3^2 0.7^4 = 15  0.04 0.4096 = 0.24576
 \Large {}_6 C_2 0.3^2 (1-0.3)^4
= \Large 15  0.3^2 0.7^4 = 15  0.09 0.2401 = 0.324135
 \Large {}_6 C_2 0.4^2 (1-0.4)^4
= \Large 15  0.4^2 0.6^4 = 15 0.16 0.1296 = 0.31104
 \Large {}_6 C_2 0.8^2 (1-0.8)^4
= \Large 15  0.8^2 0.2^4 = 15  0.64 0.0016 = 0.01536

以上より、「0.324135」が最も大きいことから、サイコロの偶数が6回中、2回出るときの母比率は、「0.3」程度と推定できます。

最尤関数による最尤推定

http://mathtrain.jp/mle ←こちらの写経です。

次は、最尤関数を用いて、先程の最尤推定を行います。

母比率=Pとおいたとき、6回中、2回出る最尤関数は次の通り


L(P) = {}_6 C_2 P^2 (1-P)^4

L(P)を最大にするPと、log L(P)を最大にするPは同じである為、 ここで計算を楽にする為、対数をとります。(対数尤度関数)


log L(P) = log\{ {}_6 C_2 P^2 (1-P)^4 \}
= log {}_6 C_2 + 2 log P + 4 log (1-P)

Pが最大値をとるとき、log L(P)の傾き? = 0 となる為、Pで微分します。


\Large \frac {d}{dP} log L(P) = 2 \frac {1}{P} + 4 \frac {1}{(1-P)} (1-P)'

\Large 0 = 2 \frac {1}{P} - 4 \frac {1}{(1-P)}

\Large P = \frac {1}{3}

log(1-P)の微分で、合成関数の微分を利用することをすっかり忘れていました。

指数関数,対数関数, 合成関数の導関数(微分計算)

指数関数

 y=log_e x → y' = log_e x

※eは自然対数の底(ネイピア数)

 y=log_a x → y' = \Large \frac{1}{x log a}

※ a>0 , a≠1

対数関数

 y = e^x  → y' = e^x
 y = a^x  → y' = a^x log a

※ a>0

合成関数である y = log(1-x) の微分

合成関数の微分では、

 \Large \frac {dy}{dx} = \frac {dy}{dt} \frac {dt}{dx}

となることより、 1-x = t とおくと、y = log(1-x) = log t となる。 よって、この微分

 \Large \frac {dy}{dx} = \frac {dy}{dt} \frac {dt}{dx} = \frac {1}{t} (1-t)' = - \frac {1}{t}

二項分布と、多項分布

多項分布...すっかり忘れてた

二値変数

「合格or不合格」「表or裏」のように2つの値を取り得る変数

二項分布

二値変数において、成功率=P、試行回数=n、成功回数=kとなる確率は以下の通り

 _nC_k P^{k} (1 - P)^{n-k} = \Large{\frac{n!}{k!(n-k)!}} P^{k} (1 - P)^{n-k}

多値変数

「二値変数」と異なり、3つ以上の値を取り得る変数

多項分布

変数の種類=kの多値変数において、各値の発生確立=P1, P2,..., Pk、発生回数=x1, x2,..., xk となる確立は以下の通り

\Large{\frac{n!}{x_1! x_2! ... x_k!}} P_1^{x_1} P_2^{x_2} ... P_k^{x_k}

さくらレンタルサーバでのsmtpメール送信は、Net::SMTPS for perlのauth()で、LOGIN を指定

end0tknr.hateblo.jp

以前、書いたgmail.comのstmp送信をそのまま利用できなかったので、いろいろ試してみたら、以下のように auth() で AUTHMETHOD='LOGIN' を指定したら動きました。

http://search.cpan.org/perldoc?Net%3A%3ASMTPS

#!/usr/local/bin/perl
use strict;
use utf8;
use Encode;
use Net::SMTPS;
use Data::Dumper;

my $SMTP_CONF =
    {host     => 'ないしょ.sakura.ne.jp',
     port     => '587',
     from     => 'ないしょ',
     auth_uid => 'ないしょ',
     auth_pw  => 'ないしょ',
     ssl=>        'starttls', # ssl / starttls / undef
     auth_method=>'LOGIN'     # CRAM-MD5 (default) / LOGIN / PLAIN / DIGEST-MD5
    };


    
main( @ARGV );

sub main {
    my ($mailto) = @_;
    
    my $smtp = Net::SMTPS->new(
        $SMTP_CONF->{host},
        Port  => $SMTP_CONF->{port},
        doSSL => $SMTP_CONF->{ssl},
        Debug => 1
    );

    $smtp->auth( $SMTP_CONF->{auth_uid},
                 $SMTP_CONF->{auth_pw},
                 $SMTP_CONF->{auth_method} )
        or die "can't login smtp server";

    my $mailto = [ $mailto ];
    my $mailto_str = join( ',', @$mailto );

    my $subject_org = 'これはテストです';
    my $subject = Encode::encode( 'MIME-Header-ISO_2022_JP', $subject_org );

    my $message = <<EOF;
このメールはテストです
EOF

    #メールのヘッダーを構築
    my $header = << "MAILHEADER_1";
From: $SMTP_CONF->{from}
Return-path: $SMTP_CONF->{from}
Reply-To: $SMTP_CONF->{from}
To: $mailto_str
MAILHEADER_1

    $header .= <<"MAILHEADER_2";
Subject: $subject
Mime-Version: 1.0
Content-Type: text/plain; charset = "ISO-2022-JP"
Content-Transfer-Encoding: 7bit
MAILHEADER_2

    $message = Encode::encode( 'iso-2022-jp', $message );

    $smtp->mail( $SMTP_CONF->{from} );
    $smtp->to(@$mailto);
    $smtp->data();
    $smtp->datasend("$header\n");
    $smtp->datasend("$message\n");
    $smtp->dataend();
    $smtp->quit;
}

DockerToolbox-1.12.0.exe を win7 に installしたら、Docker Quickstart Terminal の実行でerror

https://www.docker.com/products/docker-toolbox

https://github.com/docker/toolbox/releases/download/v1.12.0/DockerToolbox-1.12.0.exe

をinstall後、Docker Quickstart Terminal でerror...

Error creating machine: Error in driver during machine creation: Unable to start the VM: C:\Program Files\Oracle\VirtualBox\VBoxManage.exe startvm default --type headless failed:
VBoxManage.exe: error: The virtual machine 'default' has terminated unexpectedly
 during startup with exit code 1 (0x1).  More details may be available in 'C:\Us
ers\endo\.docker\machine\machines\default\default\Logs\VBoxHardening.log'
VBoxManage.exe: error: Details: code E_FAIL (0x80004005), component MachineWrap,
 interface IMachine

Looks like something went wrong in step ´Checking if machine default exists´..
. Press any key to continue...

↑このように表示されたので、 VBoxHardening.log を覗いてみると、以下の通り。 「Try 'sc.exe query vboxdrv'」らしいので実行してみましたが、原因は特定できず。

23c0.1744: supR3HardenedWinInitAppBin(0x0): '\Device\HarddiskVolume2\Program Files\Oracle\VirtualBox'
23c0.1744: System32:  \Device\HarddiskVolume2\Windows\System32
23c0.1744: WinSxS:    \Device\HarddiskVolume2\Windows\winsxs
23c0.1744: KnownDllPath: C:\Windows\system32
23c0.1744: supR3HardenedVmProcessInit: Opening vboxdrv stub...
23c0.1744: Error opening VBoxDrvStub:  STATUS_OBJECT_NAME_NOT_FOUND
23c0.1744: supR3HardenedWinReadErrorInfoDevice: NtCreateFile -> 0xc0000034
23c0.1744: Error -101 in supR3HardenedWinReSpawn! (enmWhat=3)
23c0.1744: NtCreateFile(\Device\VBoxDrvStub) failed: 0xc0000034 STATUS_OBJECT_NAME_NOT_FOUND (0 retries)

Driver is probably stuck stopping/starting. Try 'sc.exe query vboxdrv' to get more information about its state. Rebooting may actually help.
2438.2818: supR3HardenedWinCheckChild: enmRequest=2 rc=-101 enmWhat=3 supR3HardenedWinReSpawn: NtCreateFile(\Device\VBoxDrvStub) failed: 0xc0000034 STATUS_OBJECT_NAME_NOT_FOUND (0 retries)

Driver is probably stuck stopping/starting. Try 'sc.exe query vboxdrv' to get more information about its state. Rebooting may actually help.
2438.2818: Error -101 in supR3HardenedWinReSpawn! (enmWhat=3)
2438.2818: NtCreateFile(\Device\VBoxDrvStub) failed: 0xc0000034 STATUS_OBJECT_NAME_NOT_FOUND (0 retries)

Driver is probably stuck stopping/starting. Try 'sc.exe query vboxdrv' to get more information about its state. Rebooting may actually help.

DockerToolbox-1.12.0.exe の前に既にinstallしていたvirtual box 5.0.24 のcentosも起動しなくなったので、コントロールパネルから「修復」を実行したら、dockerもvirtualboxも問題なく起動するようになりました。 何だったんでしょうね? f:id:end0tknr:20161004072153p:plain

download streaming file by rtmpdump and , convert to mp4 by ffmpeg

#!/usr/local/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use FindBin;
use LWP::UserAgent;
use XML::Simple;
use Data::Dumper;

## NHKゴガク https://www2.nhk.or.jp/gogaku/english/

my $MUSIC_OUT_DIR = $FindBin::Bin;

my $MUSIC_LIST_ROOT = 'https://www2.nhk.or.jp/gogaku/st/xml';
my $MUSIC_LIST_CHANNELS =
    {english=>[
               'enjoy',         #エンジョイ・シンプル・イングリッシュ
               'basic1',        #基礎英語1
               'basic2',        #基礎英語2
               'basic3',        #基礎英語3
               'kaiwa',         #ラジオ英会話
               'timetrial',     #英会話タイムトライアル
               'kouryaku',      #攻略!英語リスニング
               'business1',     #入門ビジネス英語
               'business2',     #実践ビジネス英語
              ],
    };

# There are some paramaters
# in https://www2.nhk.or.jp/gogaku/st/flash/sound/ggk_str_pc3.swf , below.
# You can extract from swf file
#  by Flare ( http://www.nowrap.de/flare.html ).
my $MUSIC_FILE_ROOT = 'rtmpe://flvs.nhk.or.jp:1935/ondemand';
my $MUSCI_FILE_SUB_PATH = 'mp4:flv/gogaku-stream/mp4';

my $RTMPDUMP_CMD = '/usr/local/bin/rtmpdump';
my $FFMPEG_CMD = '/usr/bin/ffmpeg';

main(@ARGV);

sub main {
    my (@cmd_args) = @_;

    for my $lang (sort keys %$MUSIC_LIST_CHANNELS ){
        for my $channel (@{$MUSIC_LIST_CHANNELS->{$lang}}){
            ## DOWNLOAD CHANNEL INFOS
            my $channel_infos = get_music_list($lang,$channel);
            
            next if(ref($channel_infos) ne 'ARRAY' or
                    scalar(@$channel_infos) ==0 );

            my $out_dir = get_output_dir($lang,$channel);

            for my $channel_info ( @$channel_infos ){
                ## DOWNLOAD MUSIC FILE by rtmpdump
                my $music_file = get_music_file($channel_info, $out_dir);
                next unless $music_file;

                sleep(2);
                
                ## CORRECT by ffmpeg
                my $mp4_file = conv_to_mp4($music_file);
                print Encode::encode('utf8',"DONE $mp4_file"),"\n";
                
                unlink $music_file or die "$music_file$!";
            }
        }
    }
}

sub conv_to_mp4 {
    my($org_file) = @_;

    my $new_file = "$org_file.mp4";
    my $cmd =
        "$FFMPEG_CMD -loglevel error -y -i $org_file -acodec copy $new_file";
    
    my $fh;
    unless( open $fh, '-|', $cmd ){
        print STDERR Encode::encode('utf8',"fail open $cmd"),"\n";
        return;
    }
    unless( close($fh) ){
        print STDERR Encode::encode('utf8',"fail close $cmd"),"\n";
        return;
    }

    return $new_file;
}

sub get_output_dir {
    my($lang,$channel) = @_;

    my $out_dir_0 = join('/',$MUSIC_OUT_DIR,$lang);
    if(not -d $out_dir_0){
        mkdir $out_dir_0 or die "fail mkdir $out_dir_0 $!";
    }
    return $out_dir_0;

    # my $out_dir = join('/',$MUSIC_OUT_DIR,$lang,$channel);
    # if(not -d $out_dir ){
    #     mkdir $out_dir or die "fail mkdir $out_dir $!";
    # }
    # return $out_dir;
}

sub get_music_file {
    my ($channel_info, $out_dir) = @_;

    my $url = join('/',
                   $MUSIC_FILE_ROOT,
                   $MUSCI_FILE_SUB_PATH,
                   $channel_info->{file});
    my $out_file = join('/',
                        $out_dir,
                        "$channel_info->{title}_$channel_info->{hdate}");
    my $cmd = "$RTMPDUMP_CMD --quiet -r $url -o $out_file";
    my $fh;
    unless( open $fh, '-|', $cmd ){
        print STDERR Encode::encode('utf8',"fail open $cmd"),"\n";
        return;
    }
    unless( close($fh) ){
        print STDERR Encode::encode('utf8',"fail close $cmd"),"\n";
        return;
    }

    return $out_file;
}

sub get_music_list {
    my ($lang, $channel) = @_;

    my $url = join('/',$MUSIC_LIST_ROOT,$lang, $channel,'listdataflv.xml');
    my $ua = LWP::UserAgent->new;
    my $res = $ua->get($url);
    if(not $res->is_success ) {
        print STDERR $res->status_line , " $url\n";
        return [];
    }

    my $xml_content = $res->content;
    $xml_content = Encode::decode('utf8',$xml_content);
    my $ret = XML::Simple::XMLin($xml_content);

    return $ret->{music};
}

open amを「 〜.jp」のようなccTLDの場合は3つ以上の「.」が必要

https://github.com/k-tamura/openam-book-jp/blob/master/preparing-for-installation.md に、

テスト目的のためであっても、localhostドメインを使用しないで下さい。 OpenAMの動作は、ドメイン名に基づいて返されるブラウザのクッキーに依存しています。基本的には、少なくとも2つの「.」(ドット)を含むドメイン名を使用していることを確認して下さい。 例) openam.example.com ※正確には、OpenAMインストール時の「Cookie ドメイン」に含める「.」の数は、「〜.com 」のようなgTLDの場合は2つでも構いませんが、「 〜.jp」のようなccTLDの場合は3つ以上が必要です。

しっかり記載されていた。勉強になります。

特に

したがって「.example.com」や「.example.co.jp」は適切であっても、「.example.jp」は不適切ということになります。

には驚いた。