無精・短気・傲慢

perlの事 いろいろ

セッションとユーザー紐づけ

 mojoliciusでセッションとユーザーを紐づけしてみた

LOGIN画面で認証したユーザーをセッションと紐づけてDBに登録しクッキーに保存したセッションにて以降の画面でユーザーを認識する。

  1. セッションが有効で無い時は認証画面を表示する。
  2. 認証画面での入力したユーザーとパスワードにてDBに登録したパスワードのハッシュ値と照合しパスワードの有効性を確認する。
  3. 入力値が有効の場合にセッションとユーザーを紐づけでDBに登録する。
  4. 元画面に戻る。
 

中置記法から抽象構文木(AST)変換し後置記法（逆ポーランド記法）の計算

 吉祥寺.pm #20 へ行ってきた

東京に出張に来ていたので2019/11/22吉祥寺.pm #20へ行ってきた。色々と刺激を受けた。発表のなかで、めもりー（@m3m0r7）さんの『PHP で AST 解析して Java の中間コードを生成する』に刺激を受けて、中置記法から抽象構文木(AST)変換し後置記法（逆ポーランド記法）の計算を作ってみた。以前に中置記法から後置記法（逆ポーランド記法）への変換と計算でスタックを使った逆ポーランド記法のプログラムを作ったが、今回はASTで計算してみた。（当然paerlで）

https://kabukawa.hatenablog.jp/entry/2019/11/25/012334 <-良くまとっ待っている

 Source

 実行

$ perl ast.pl 10+1
10 + 1
11
$

mojoliciousで動くように修正した。

 ast.pl

use lib 'lib';
use Ast;
use Data::Dumper;

my $c = Ast->new;
#my $t = $c->adjust('(100+2**3-((1+2)/(4+-2))*(-10))');
my $t = $c->adjust(join '',@ARGV);
$c->item_split($t);
my $root = $c->makeTree(@{$c->{item}});

print "$t\n";
print $c->readTree($root),"\n";;

 Ast.pm

package Ast;
use strict;
use warnings;
use Data::Dumper;

my $op = +{ '-' => [sub {$_[0] - $_[1]},1],         # オペレータ定義
           '+' => [sub {$_[0] + $_[1]},1],
           '*' => [sub {$_[0] * $_[1]},2],
           '/' => [sub {$_[0] / $_[1]},2],
           '%' => [sub {$_[0] % $_[1]},2],
           '**' => [sub {$_[0] ** $_[1]},3],
           #'x' => [sub {$_[0] * $_[1]},8], # 多項式対応？
           '(' => [sub { },9],
           ')' => [sub { },10],
        };
sub ast{
    Ast->new('formula'=>shift())->{anser};
}
sub _ast{
    my $s = shift;
    $s->{anser} = $s->readTree($s->makeTree(@{$s->item_split($s->adjust(shift))->{item}}));
}
sub new {                                           # コンストラクター
    my $class = shift;
    my $self = {@_};
    bless $self,$class;
    $self->setReOps();
    $self->_ast($self->{formula}) if (exists $self->{formula});
    return $self;
}
sub setReOps{                                       # 演算子の正規表現作成
    my $s = shift;
    $s->{ops} = join ('|',map {s/(.)/\\$1/g;$_;} sort {length $b <=> length $a} keys %$op);
    $s->{ops} = "(".$s->{ops}.")";
    return $s;
}
sub newNode{
    my $s = shift;
    return {data => shift(),left =>shift(),right=>shift()};
}
sub readTree{                                       # AST計算
    my ($s,$node) = @_;
    do{$node->{$_} = $s->readTree($node->{$_}) if(ref($node->{$_}) eq "HASH")} for ('left','right');
    exists $op->{$node->{data}} ? $op->{$node->{data}}->[0]($node->{left},$node->{right})
                                : $node->{data};
}
sub makeTree{                                       # ATS組み立て
    my $s = shift;
    while($_[0] eq '(' and $_[-1] eq ')'){
        my ($r,$sw) = (0,0);
        for(@_){                                    # '('の深さを計算
            $r++ if($_ eq '(');                     
            $r-- if($_ eq ')');
            $sw++ if($r == 1 and $_ eq '(');
        }
        if($sw == 1){                               #  一番外側の括弧を外す
            shift;
            pop;
        }else{
            last;
        }
    }
    return shift() if(@_ <= 1);                     # 要素が一つの時は要素を返す
    my ($prio,$i,$m,$r) = (99,-1,0,0);
    for(@_){                                        # 一番右側の一番プライオリティの低いオペレータを検索
        $i++;
        if(/^$s->{ops}$/){
            $r++ if($_ eq '(');
            $r-- if($_ eq ')');
            next if($r or $_ eq ')');              #  括弧の間は読み飛ばす
            if($op->{$_}->[1]+$r <= $prio){
                $prio = $op->{$_}->[1];
                $m = $i;
            }
        }
    }
    return $s->newNode($_[$m],                      # オペレータとオペランド（右と左）を返す
                            $s->makeTree(@_[0 .. $m-1]),
                            $s->makeTree(@_[$m+1 .. $#_])
                );
}
sub item_split{                                     # 計算式を要素に分解
    my $s = shift;
    my $text = shift || $s->{_text};
    $s->{item} = [split ' ',$text];
    return $s;
}
sub adjust{                                         # 計算式の要素をスペースで分割
    my ($s,$text) = @_;
    $text =~ s/$s->{ops}/ $1 /g;
    $text =~ s{([\d\)])\s*\(}{$1 \* \(}g;           #   開き括弧の前が演算子じゃない時に*を補完 ex). (1+2)(2-1) -> (1+2)*(2-1)
    $s->{_text} = $text =~ s/($s->{ops}\s*-)\s*/$1/g;
    return $text;
}
1;

--

 

mojoliciousでユーザー認証

 LOGIN画面を追加

 mmt.pm

Router認証処理を追加する。underで各処理の前に認証済みの確認処理を追加。認証を必要としない処理は元々のRouterを使う。

--- a/toolmmt/lib/Tool/mmt.pm
+++ b/toolmmt/lib/Tool/mmt.pm
@@ -16,15 +16,20 @@ sub startup {
   # Router
   my $r = $self->routes;
   $r->namespaces(['Tool::mmt::Controller']);
+  # ユーザー認証
+  my $sr = $r->under->to('auth#check');
   # Normal route to controller
   $r->get('/')->to('example#welcome');
-  $r->get('/mmt/:_table/desc')->to('mmt#desc');
-  $r->get('/mmt/:_table')->to(controller => $self->controller,action =>'mainform');
-  $r->post('/mmt/:_table')->to(controller => $self->controller,action => 'registry');
-  $r->get('/mmtx/:controller')->to(controller => $self->controller,action =>'mainform');
-  $r->post('/mmtx/:controller')->to(controller => $self->controller,action => 'registry');
-  $r->any('/mmtx/:controller')->to(controller => $self->controller,action => 'mainform');
-  $r->any('/rwt/:controller')->to(controller => $self->controller,action => 'print_main');
+  $sr->get('/logout')->to('auth#logout');
+  $sr->any('/login')->to('auth#login');
+  $sr->any('/mmt/login')->to('auth#login');
+  $sr->get('/mmt/:_table/desc')->to('mmt#desc');
+  $sr->get('/mmt/:_table')->to(controller => $self->controller,action =>'mainform');
+  $sr->post('/mmt/:_table')->to(controller => $self->controller,action => 'registry');
+  $sr->get('/mmtx/:controller')->to(controller => $self->controller,action =>'mainform');
+  $sr->post('/mmtx/:controller')->to(controller => $self->controller,action => 'registry');
+  $sr->any('/mmtx/:controller')->to(controller => $self->controller,action => 'mainform');
+  $sr->any('/rwt/:controller')->to(controller => $self->controller,action => 'print_main');
   $r->any('/api/:controller/:action')->to('example#welcom');
 }

 Auth.pm

認証処理は全てAuth.pmに押し込む。Routerのunderにて全ての処理の前にcheckを実行しsessionが確立していればreturn 1にて終了し、確立していない時はユーザー認証画面に繊維する。（ユーザー認証(userAuth)処理は未だ無い）

--- /dev/null
+++ b/toolmmt/lib/Tool/mmt/Controller/Auth.pm
@@ -0,0 +1,54 @@
+package Tool::mmt::Controller::Auth;
+use Mojo::Base 'Tool::mmt::Controller::Mmt';
+
+sub login {
+    my $s = shift;
+    $s->redirect_to($s->param('url')) if $s->param('url');
+    $s->render( template => 'mmt/index');
+}
+sub check {
+    my $s = shift;
+    # セッション確定済なら認証通貨
+    if($s->session('session')){
+        return 1;
+    }
+    #パスワードチェック
+    if($s->userAuth()){
+        return 1;
+    }
+    $s->stash( 'url' => $s->req->url->to_abs );
+    $s->render( template => 'auth/login');
+    return undef;
+}
+sub userAuth{
+    my $s = shift;
+    my $user = $s->param('user')||'';
+    my $pass = $s->param('passwd')||'';
+    if ($user eq '' or $pass eq '' or $user =~ /(admin|root)/i){
+        $s->param('user','guest');
+        $s->param('passwd','guest01');
+        return undef;
+    }
+    my $sessionId = $s->randomStr();
+    $s->session('session' => $sessionId);
+    return 1;
+}
+sub logout{
+    my $s = shift;
+    # セッション削除
+    $s->session(expires => 1);
+    $s->stash( 'url' => 'login' );
+    $s->render( template => 'auth/login');
+}
+sub randomStr{
+    my $s = shift;
+    my %arg = (-length =>16,
+                        -str => (join '',('A'..'Z','a'..'z','0'..'9')),
+                         @_);
+    my @str = split //,$arg{'-str'};
+    my $str = "";
+    for(1 .. $arg{'-length'}){$str .= $str[int rand($#str+1)];}
+    return $str;
+}
+
+1;

 auth/login.html.ep

ログイン画面

--- /dev/null
+++ b/toolmmt/templates/auth/login.html.ep
@@ -0,0 +1,13 @@
+% layout 'defrwt';
+% title 'login' ;
+<h2>Login</h2>
+
+%= form_for login => (method => 'post') => begin
+ <br>Name:
+ %= text_field 'user'
+ <br>password:
+ %= text_field 'passwd'
+ <br>
+ %= submit_button 'Login'
+ %= hidden_field url => $url
+% end

 default.html.ep

デフォルト画面にlogoutのリンクを追加

--- a/toolmmt/templates/layouts/default.html.ep
+++ b/toolmmt/templates/layouts/default.html.ep
@@ -50,6 +50,7 @@
   <body>
     <input type=hidden name=_focus id=_focus value=<%= param('_focus') %>>
     <div class="main">
+      <a href=/logout>logout</a>
       <%= content %>
     </div>
     <div class="sidebar">

 mmt/index.html.ep

ログイン後のスタートページ

--- /dev/null
+++ b/toolmmt/templates/mmt/index.html.ep
@@ -0,0 +1,3 @@
+% layout 'default';
+% title "mmt - index " ;
+<h1>INDEX</h1>

じゃんけん判定

 じゃんけん勝敗判定アルゴリズム

  • 二人でじゃんけん
    • ($a - $b + 3) % 3
  • 複数人でじゃんけん

じゃんけんの勝敗なんて考えた事なかった。二人でじゃんけんを行った時の「グー」、「チョキ」、「パー」の9通りの組み合わせで、「勝ち」、「負け」、「引き分け」の３通りの結果が１行で判断出来るとは…「じゃんけん勝敗判定アルゴリズムの思い出」で衝撃を受けて早速じゃんけん判定ページを作ってみた。（やっぱりperlで）

これはもっとすごい($r |= 1 << $a)1行の繰り返しでじゃんけん判定が出来る【ネタばれ】大は小を兼ねるジャンケンプログラムのアルゴリズム（どんなプログラムでもアルゴリズムは使用可）【注意】

 ちゃぼ

WebSocketのちゃぼにも『じゃんけん機能』を追加したよ

  じゃんけんポン

<html>
  <head>
      <meta charset="utf-8"/>
      <script src="webperl.js"></script>
      <script src="https://code.jquery.com/jquery-3.3.1.min.js"
      integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8="
      crossorigin="anonymous"></script>
  </head>
  <body>
  <h1><a href="http://park15.wakwak.com/~k-lovely/cgi-bin/wiki/wiki.cgi?page=%A4%B8%A4%E3%A4%F3%A4%B1%A4%F3%C8%BD%C4%EA">じゃんけんぽん</a></h1>
  <button type="button" id="gu"><font size=50>&#x270A;</font></button>
  <button type="button" id="choki"><font size=50>&#x270C;</font></button>
  <button type="button" id="pa"><font size=50>&#x270B;</font></button>
  <hr>
  <div id="pc" style="font-size:50px;">
      &#x270A;
  </div>
  <div id="result">
  </div>
  <hr>
  <h2>5人でじゃんけんポン</h2>
  <div id="pc9" style="font-size:50px;">
      &#x270A;
  </div>
  <div id="result2">
  </div>
      <script type="text/perl">
           use utf8;
           my $item = {qw(0 &#x270A; 1 &#x270C; 2 &#x270B;)};
           my $jq = js('jQuery');
           sub pon{
               my $you = shift;
               my $pc = int(rand()*3);
               my @pc = map {int(rand()*3)} (1 .. 3);                                                                                  
               $jq->('#pc')->html($item->{$pc});
               $jq->('#pc9')->html(join('|',map{$item->{$_}} ($pc,@pc)));
               $jq->('#result2')->html(judge($you,$pc,@pc));
               return qw(DRAW Your_lost Your_win)[judg($you,$pc)];
           }
           sub judg{
               return (shift() - shift() + 3)%3;
           }
           sub judge{
               my $r=0;
               $r |= 1<<$_ for(@_);
               return qw(不明 引き分け 引き分け グーの勝ち 引き分け パーの勝ち チョキの勝ち 引き分け)[$r];
           }

           $jq->('#gu')->on('click',sub{ $jq->('#result')->html(pon(0)); });
           $jq->('#choki')->on('click',sub{ $jq->('#result')->html(pon(1)); });
           $jq->('#pa')->on('click',sub{ $jq->('#result')->html(pon(2)); });

      </script>
  </body>
</html>

 ターミナルでじゃんけんぽん

#!/usr/bin/perl
use strict;
use warnings;

my $item = {qw(0 グー 1 チョキ 2 パー)};
my $finish = 'e';

play();
sub play{
    while((my $input = prompt('> ')) ne $finish){
        my $computer = int(rand()*3);
        print "あなた-> $item->{$input} --- $item->{$computer} <-コンピュータ \n\n";
        print "@{[qw(あいこ あなたの負け あなたの勝ち)[judg($input,$computer)]]}です\n\n";
    }
}
sub judg{
    my ($you,$computer) = @_;
    return ($you - $computer + 3) % 3;
}

sub prompt{
    my $ps1 = shift;
    print join("、",message()),"\n";
    print $ps1;
    while(<>){
        chomp();
        return $finish if(/^(e|q|exit|quit|999)$/i);
        return $_ if(exists $item->{$_});
        print $ps1;
    }
    return $finish;
}
sub message{
    map {"$_ :$item->{$_}"} sort keys(%$item);
}

 ERROR

ccess to script at 'https://webperlcdn.zero-g.net/v0.07-beta/webperl.js' from origin 'http://www21051ue.sakura.ne.jp' has been blocked by CORS policy: No 'Access-Control-Allow-Origin' header is present on the requested resource.

perl de Heptagon (七角形)

 七角形を描画

編集

とりあえず描画してみる

#!/usr/bin/env perl
use Mojolicious::Lite;

app->types->type(data => 'application/octet-stream');
app->types->type(mem  => 'application/octet-stream');
app->types->type(wasm => 'application/wasm');

get '/:n' => {n => 7} => sub {
  my $c = shift;
  $c->render(template => 'index');
};

app->start;
__DATA__

@@ index.html.ep
% layout 'default';
% title '七角形';
<h1><a href="http://park15.wakwak.com/~k-lovely/cgi-bin/wiki/wiki.cgi?page=perl+de+Heptagon+%28%BC%B7%B3%D1%B7%C1%29">perl de Heptagon (七角形)</a></h1>

@@ layouts/default.html.ep
<!DOCTYPE html>
<html>
  <head><title><%= title %></title>
  <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  <script src="webperl.js"></script>
  <script type="text/perl">
    use WebPerl qw/js/;
    use List::Util qw/reduce/;
    use Data::Dumper;
    
    my $canvas = js('document')->getElementById('canvas');
    my $ctx = $canvas->getContext("2d");
    my ($w,$h) = (500,300);
    my ($cx,$cy) = ($w/2, $h/2) ;
    my $r = ($cy<$cx ? $cy : $cx) / 1.1;
    my $pi = 3.141592;
    ($canvas->{width},$canvas->{height})   = ($w,$h);
    my $n = <%= $n %> + 0;
    $n = $n > 100 || $n < 2 ? 7 : $n; 
    my @paricles = ();
    push(@paricles,particle($_,$n)) for (1 .. $n);
    draw();
    print Dumper(@paricles);
 
    sub particle{
        my ($i,$n) = @_;
        return {
            x => $r * cos($i*2*$pi/$n-($pi/2)),
            y => $r * sin($i*2*$pi/$n-($pi/2)),
            rgba => 'rgba(' . join(',',map{rand_rgb()}(1..3)) . ',' . rand() . ')',
        };
    }
    sub draw{
        $ctx->{lineWidth} = 5;
        reduce {draw_line($a,$b),$b} (@paricles,$paricles[0]);
    }
    sub draw_line{
        my ($s,$e) = @_;
        $ctx->beginPath();
        $ctx->moveTo($s->{x} + $cx,$s->{y} + $cy);
        $ctx->lineTo($e->{x} + $cx,$e->{y} + $cy);
        $ctx->{strokeStyle} = $s->{rgba};
        $ctx->stroke();
    }
    sub rand_rgb{
        my $r = shift||255;
        return int(rand()*$r);
    }
  </script>
  <script>
    window.addEventListener("load", function () {
        document.getElementById('output')
            .appendChild( Perl.makeOutputTextarea() );
    });
  </script>
  </head>
  <body><%= content %><canvas id="canvas"></canvas><div id="output"></div>
  </body>
</html>

  LINE ART

編集

LINE ARTで書いた七角形をperlで書いてみた。webperl+mojoliciousでcanvasに七角形を描画してみた。

 webperl de canvas　

編集
  • getElementByIdメソッドでHTMLと関連付けて、getContextメソッドで描画機能を有効にする
    • getElementByIdメソッドでid名を指定してHTML側と関連付けます。 次に、getContextメソッドで描画機能を有効にします。JavaScriptとほぼ同じ書き方です。
my $canvas = js('document')->getElementById('canvas');
my $ctx = $canvas->getContext("2d");
  • canvasのメソッドには $object->Method()でアクセスする。
$ctx->stroke();
  • canvasのプロパティには$object->{Property}でアクセスする。
$ctx->{strokeStyle} = 'rgba(0,0,100,0.5)';

 mojolicious de webperl

編集

mojoliciousでwebperlを使ってみる。まずは雛形をつくる。

$ mojo generate lite_app polygon.pl

pubulicの下にhttps://webperl.zero-g.net/よりダウンロードしたファイルを展開する。

$ tree .
.
├── polygon.pl
└── public
    ├── emperl.data
    ├── emperl.js
    ├── emperl.wasm
    ├── LICENSE_artistic.txt
    ├── LICENSE_gpl.txt
    ├── lineArt.css
    ├── mini_ide
    │    ├── emscr_ide.css
    │    ├── emscr_ide.js
    │    └── webperl_mini_ide.html
 　 ├── README.md
 　 ├── regex_tester.html
　  ├── runtests.html
　  ├── webperl_demo.html
　  ├── webperl.js
 　 └── webperl.psgi

雛形にMIMEを追加する

app->types->type(data => 'application/octet-stream');
app->types->type(mem  => 'application/octet-stream');
app->types->type(wasm => 'application/wasm');

テンプレートにwebperl.jsを追加してperlを書く

 <script src="webperl.js"></script>
 <script type="text/perl">
   use WebPerl qw/js/;
   my $canvas = js('document')->getElementById('canvas');
   my $ctx = $canvas->getContext("2d");
   ・
   ・
   ・
 </script>

 perl de Heptagon

編集
  • 多角形を書くために頂点の位置を計算する。
  • ラジアン
    • 180°= π[rad]
    • 正n角形の各頂点は、単位円の中心をn等分しているので、等分した1コ当りの中心角は
      • 中心角 = 2π÷n
   my $n = 7;
   my @paricles = (); 
   push(@paricles,particle($_,$n)) for (1 .. $n);

   sub particle{
       my ($i,$n) = @_;
       my $ret = {};
       $ret->{x} = $r * cos($i*2*$pi/$n);
       $ret->{y} = $r * sin($i*2*$pi/$n);
       return $ret;
   }

正七角形とは、各辺と全ての内角の大きさがそれぞれ等しい七角形。ひとつの内角の大きさはラジアン角で5π/7（約128.57度）である。

正七角形をコンパスと定規（長さの計測が不可能なもの）で作図することは不可能であるが、コンパスと目盛り付の定規（長さの計測が可能なもの）を用いたり、あるいは折り紙を用いるなどすれば描画可能である。

辺をa、対角線をb,cとすると　　１/ａ＝１/ｂ＋１/ｃ　が成り立つ

WebPerl

 Welcome to WebPerl!

欲しかったやつ！！javascriptをperlで置き換えられる。

https://webperl.zero-g.net/

WebPerl uses the power of WebAssembly and Emscripten to let you run Perl 5 in the browser!
WebPerl does not translate your Perl code to JavaScript,
instead, it is a port of the perl binary to WebAssembly,
so that you have the full power of Perl at your disposal!

WebPerlは、WebAssemblyとEmscriptenの機能を使って、Perl 5をブラウザで実行できるようにします。WebPerlはあなたのPerlコードをJavaScriptに変換するのではなく、WebAssemblyへのperlバイナリのポートですので、自由にPerlの能力をフルに活用できます！

demo

[webperl_demo.html]

<!doctype html>
<html lang="en-us">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<title>WebPerl &lt;script&gt; Demos</title>

<script src="webperl.js"></script>

<!-- Please see the documentation at http://webperl.zero-g.net/using.html -->

<!-- Example 1: A really basic script -->
<script type="text/perl">
print "Hello, Perl World!\n";
</script>

<!-- Example 2: Accessing JavaScript -->
<script type="text/perl">
use warnings;
use strict;
use WebPerl qw/js/;

js('document')->getElementById('my_button')
	->addEventListener("click", sub {
		print "You clicked 'Testing!'\n";
	} );

</script>

<!-- Example 3: Using jQuery -->
<script src="https://code.jquery.com/jquery-3.3.1.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
<script type="text/perl">
use warnings;
use strict;
use WebPerl qw/js/;

my $jq = js('jQuery');
my $btn = $jq->('<button>', { text=>"Click me!" } );
$btn->click(sub {
	print "You clicked the jQuery button!\n";
} );
$btn->appendTo( $jq->('#buttons') );

# And a demo of AJAX using jQuery:
use Cpanel::JSON::XS qw/encode_json/;
use Data::Dumper;
my $data_out = { hello => "Hello, World!\n" };
$jq->ajax( '/ajaxtest', {
	method => 'POST', # we're sending JSON in the POST body
	data => encode_json($data_out),
} )->done( sub {
	my $data_in = shift;
	print "AJAX Success! Data: ", Dumper($data_in->toperl);
} )->fail( sub {
	my ($jqXHR, $textStatus, $errorThrown) = @_;
	print "AJAX Failed! ($errorThrown)\n";
} );

</script>

<!-- Optional STDOUT/STDERR text area (if you don't use this, output goes to Javascript console) -->
<script>
window.addEventListener("load", function () {
	document.getElementById('output')
		.appendChild( Perl.makeOutputTextarea() );
});
</script>

</head>
<body>

<p>This is a demo of <a href="http://webperl.zero-g.net" target="_blank">WebPerl</a>!</p>

<div id="output"></div>
<div id="buttons">
	<button id="my_button">Testing!</button>
</div>

</body>
</html>

B-TREE

  B-TREEの考察

B-TREEを理解する為にviz3/btree.c(c)をperlに写経してみた。とりえず動く物を作ってから考えようと。【デモ】←クリック

sub btree{
    my $s = shift;
    $s->M(int(rand(8)+2));
    $s->debugtext($s->debugtext . " (M:" . $s->M . ")"); 
    $s->insert($_ * 2) for (11 .. 15);
    $s->insert($_ * 2 - 1) for (1 .. 6);
    $s->insert($_) for (1 .. 20);
    $s->insert($_) for (30 .. 100);
    $s->insert(7);
    $s->delete($_) for (92 .. 99);
    $s->delete(11);
    $s->delete(51);
    $s->insert(11);
    $s->insert(51);
    $s->delete(75);

    $s->level(0);
    $s->tree_dump($s->root);
    $s->render(template => 'btree/btree','message'=> $s->message,
           'treetext'=>$s->debugtext);
}

   wikiより

  B木

B木（びーき）は、コンピュータサイエンスにおけるデータ構造、特に木構造の一つ。ブロック単位のランダムアクセスが可能な補助記憶装置（ハードディスクドライブなど）上に木構造を実装するのに適した構造として知られる。実システムでも多用されており、データベース管理システムの多くはB木による索引を実装している（B木の改良型または亜種であるB+木やB*木を使うことが多い）。

  構造

多分岐の平衡木(バランス木)である。1 ノードから最大 m 個の枝が出るとき、これをオーダー m のB木という。後述する手順に従って操作すると、根と葉を除く「内部ノード」は最低でも m /2 の枝を持つことを保証できる。各ノードは、枝の数 - 1 のキーを持つ。枝1 ～ 枝m と キー1 ～ キーm -1 を持つとき、枝i には キーi -1 より大きく キーi より小さいキーだけを保持する（キーの重複を許す場合はどちらかに等号をつける）。葉ノードの定義は文献によって違いが見られる。木の終端をヌルポインタのような特殊な値で表す場合、枝がすべて終端記号となっているノードを葉とする。これに対して一部の文献では、終端を表すためにキーが0個のノードを連結し、このノードを葉と定義している。すなわち、後者の定義における葉ノードの親が、前者の定義における葉ノードとなる。後者の定義をとる文献では「葉ノードはキーを持たない」ということになる。以下の記述では、前者の定義に従うものとする。ノードはページと呼ばれることもある。特にハードディスクドライブなどの外部記憶装置を使ってB木を実現する場合によく見られる。この場合、各ノード（ページ）のサイズが、外部記憶装置のブロックサイズの整数倍になるようにオーダーを調整することが多い。B木の中でも特に、オーダー3のものを2-3木、オーダー4のものを2-3-4木と呼ぶ。

B-TREE

B-TREE

削除しました
Debug TREE (M:9)
N -> 7ー [ 10, 20, 35, 45, 55, 65, 76 ]
N -> 9ーー [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ]
N -> 9ーー [ 11, 12, 13, 14, 15, 16, 17, 18, 19 ]
N -> 9ーー [ 22, 24, 26, 28, 30, 31, 32, 33, 34 ]
N -> 9ーー [ 36, 37, 38, 39, 40, 41, 42, 43, 44 ]
N -> 9ーー [ 46, 47, 48, 49, 50, 51, 52, 53, 54 ]
N -> 9ーー [ 56, 57, 58, 59, 60, 61, 62, 63, 64 ]
N -> 9ーー [ 66, 67, 68, 69, 70, 71, 72, 73, 74 ]
N -> 16ーー [ 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 100 ]