無精・短気・傲慢

perlの事 いろいろ

perl memo

 フリップフロップ演算子

あるファイルの20行目~30行目まで抜き出すときは

$ perl -ne ‘print if (20 .. 30);’ file

ファイルからタイトルを抜き出そうとしたとき

$ perl -ne 'print if (/<title>/.. /<\/title>/);' a.html

開始条件と終了条件が同時にtrueになったときにはそこで終了されたら困るようなときというのがある。そんな場合には、「…」を使います。

たとえば、開始マークと終了マークに挟まっているのではなくて、ただ切れ目だけがわかるようなファイル。

$ perl -ne 'print if (/<hr>/ ... /<hr>/);' bbs_log

 入れ子を許した括弧内にマッチさせる

http://www.din.or.jp/~ohzaki/regex.htm#GetNestedParen より

$openclose = qr/\([^()]*(?:(??{$openclose})[^()]*)*\)/;
while ($str =~ /($openclose)/g) {
 print $1, "\n";
}

javascriptのテキストより関数を取り出す。

sub useFunc{
       my $s = shift;
       my $func = shift;
       my $javascript = $s->formScript();
       #my $openclose = qr/\{[^{}]*(?:(??{$openclose})[^{}]*)*\}/;
       #$javascript =~ /(function\s+$func\s*\([^)]*\)$openclose)/;
       $javascript =~ /(function\s+$func\s*\([^)]*\)(\{(?:(?>[^\{\}]+)|(?2))*\}))/;
       return $1;
}

 記号だけのperlプログラム

「はろーわーるど!」と表示 http://perl-users.jp/articles/advent-calendar/2010/sym/12 より

$ perl -Mre=eval -e "''=~(('(').((''=='').''^'^'^'~'^'.').((''=='').''^'='^'^'^')').('^'^'.').('='^'~'^(''=='').'').('('^'^'^'.'^(''=='').'').('('^'^'^')'^(''=='').'').('~'^'('^'='^(''=='').''^'.').((''=='').''^'='^'.').~('~'^'^'^'('^')'^'=').~('~').~('.'^'~').~('^'^'('^'~'^'='^')').~('.'^'='^'('^'^'^')'^(''=='').'').~((''=='').''^'~'^'=').~('='^'('^')'^'^'^'~').~('.'^'^'^'='^(''=='').'').~('='^'~').~('^'^'~'^')'^'='^'(').~((''=='').''^'='^')'^'('^'^'^'.').~('^'^'.').~('^'^'='^')'^'~'^'(').~('^'^'.'^(''=='').''^'=').~('~'^'=').~('='^'^'^'~'^')'^'(').~(')'^'^'^'.'^'('^(''=='').''^'=').~('~'^'.'^(''=='').''^'='^'(').~('~'^'='^')'^'^'^'(').~('~').~('('^'~').~(')'^'^'^'('^'~'^(''=='').'').~('='^'~').~('~').('('^'.'^(''=='').''^'=').('.'^(''=='').''^'=').((''=='').''^')'^'.'^'='^'('^'^').(')'))"

Hello world! と表示

$ perl -Mre=eval -e "''=~('(?{'.('[[).[|\`%,,/\`[/[@$'^'+)@@/^(@@@@@,@),@').'! \"})')"

use re 'eval';しないとエラーとなる

 シンタックスハイライト

少しお洒落なソースファイルを貼る時に便利なパールモジュール Text::VimColor使い方はとっても簡単。内部でvimを呼んでるらしい。cssはlight.cssが同梱されてます。

use Text::VimColor;
    :
    :
print start_html(-title=>"@{[$in->param('file')]}",
               -style=>[{'src'=>'css/light.css'}],
               -head=> $in->meta({ -http_equiv => 'Content-Type',-content => "text/html; charset=$charset" }));
    :
    :
open(FILE,"<:utf8","@{[$in->param('file')]}");
{ local $/ = undef;
  my $text = <FILE>;
  print Text::VimColor->new(filetype=>'perl',string=>$text)->html;
}
    :
    :

 与えられた数値以下の最大の素数を探す

$ perl -E 'sub f{$x=pop;for(2..sqrt($x)){if ($x%$_==0){ return $_}}return 0} while(f($d|=pop)){$d--}say $d' 100

 SQLite

$ perl -MDBI -MData::Dumper -e 'print Dumper (DBI->connect(q{DBI:SQLite:dbname=d:/mfrdata/server.db})->selectall_arrayref(q{pragma table_info("TableName")},+{Slice=> +{}}))'
$ perl -MDBI -MData::Dumper -e 'print Dumper (DBI->connect(q{DBI:SQLite:dbname=d:/mfrdata/server.db})->selectall_arrayref(q{select name from sqlite_master where type = "table"},+{Slice=> +{}}))'

 web server

ウェーブサーバーみたいな物を作ってみた。

HTTP::DaemonのMulti-PartレスポンスをCGI.pmでパースする方法が解らなかったので手でパースしてしまった。

package myapp;
{
use strict;
use base qw(HTTP::Response);
use HTTP::Status;

use DBI;
use IO::String;
use CGI;
use Data::Dumper;

my $PUBLIC = q{public};

sub router {
  my ($s,$c,$r) = @_;
  $s->init($c,$r);
  if ($r->method eq 'GET'){
    if($r->url->path =~ /\/(.+\.cgi\.*)/){
      $s->post($c,$r);
    }
    elsif($r->url->path =~ /\/(.+\..+)/){
      $c->send_file_response("$PUBLIC/$1");
    }
  }
  elsif ($r->method eq 'POST'){
    $s->post($c,$r);
  }
  else {
    $c->send_error(RC_FORBIDDEN);
  }
}
sub post {
  my ($s,$c,$r) = @_;
  $c->send_response;
  print $c "<html><body><pre>";
  print $c (Dumper $r);
  print $c "-" x 80 . "\n";
  for($s->{cgi}->param){
    print $c "[$_] => [" . $s->{cgi}->param($_) . "]\n";
  }
  print $c "</pre>";
  print $c "</body></html>";
}
sub init{
  my ($s,$c,$r) = @_;
  my $form_parameters = $r->uri;
  if($form_parameters =~ /^.*\?(.+)/){
     $form_parameters = $1 . "&";
  }
  else{
     $form_parameters = q{};
  }
  $form_parameters .= $r->content;
  if($r->content =~ /^--/){
    my ($boundary) = split(/\n/, $form_parameters); chop($boundary);
    # substr($boundary, 0, 2) = ''; # delete the leading "--" !!!
    $ENV{'CONTENT_TYPE'} = $r->content_type . "; boundary=$boundary";
    $ENV{'CONTENT_TYPE'} = $r->{_headers}->{'content-type'};
    $ENV{'CONTENT_LENGTH'} = $r->content_length;
    close STDIN; my $t = tie *STDIN, 'IO::String';
    $t->open($form_parameters);
    local $| = 1;
    $s->{cgi} = CGI->new();
    local $/ = "\r\n";
    my @param = split($boundary,$r->content);
    for(@param){
      if(/\sname="([^"]+)"/){
        my $name = $1;
        my ($head,$body) = split("\r\n\r\n",$_);
        chomp($body);
        $body =~ s/$boundary//;
        $s->{cgi}->param($name,$body);
      }
    }
  }
  else{
    $s->{cgi} = CGI->new($form_parameters);
  }

}
}
1;

package main;

use strict;
use HTTP::Daemon;

use POSIX ":sys_wait_h";
sub REAPER {
    $SIG{CHLD} = \&PEAPER;
    while (my $pid = waitpid(-1,WNOHANG)) {
        print "End $pid \n";
    }
} 
#$SIG{CHLD} = \&PEAPER;
$SIG{CHLD} = 'IGNORE';

my $pid;
my $d = HTTP::Daemon->new(
          LocalPort => 8888,
        ) || die;
print "Please contact me at: <URL:", $d->url, ">\n";
my $app = myapp->new();
while (1){
  my $c = $d->accept;
  if (!defined($pid = fork)) {
    die "can't fork:$!\n";
  }
  elsif ($pid) {
  }
  else {
    $d->close;
    while (my $r = $c->get_request) {
      $app->router($c,$r);
 }
    $c->close;
    undef($c);
    exit();
  }
  $c->close;
  undef($c);
}

 ハノイの塔を解く

AからCへ数枚の円盤を移動する

 
use strict;
hanoi(pop,"A".."C",sub {print qq{@{[++$a]}: $_[1]($_[0])=>$_[3]\n}});

sub hanoi{
  return unless($_[0]);
  push(@_,$_[0]-1);
  hanoi(@_[-1,1,3,2,4]);
  $_[4]->(@_);  
  hanoi(@_[-1,2,1,3,4]);
}
$ perl hanoi.pl 4
1: A(1)=>B
2: A(2)=>C
3: B(1)=>C
4: A(3)=>B
5: C(1)=>A
6: C(2)=>B
7: A(1)=>B
8: A(4)=>C
9: B(1)=>C
10: B(2)=>A
11: C(1)=>A
12: B(3)=>C
13: A(1)=>B
14: A(2)=>C
15: B(1)=>C
$ 

terminalでハノイの塔を表示する

 
use strict;
my $n = shift;
my @towers = ('A' .. 'C');
my $hanoi_towers->{$towers[0]} = [ reverse ( 1 .. $n ) ];
print "\e[2J";
hanoi_print($hanoi_towers);

hanoi($n,@towers,sub {
  push(@{$hanoi_towers->{$_[3]}},pop(@{$hanoi_towers->{$_[1]}}));
  hanoi_print($hanoi_towers);
  });

sub hanoi{
  return unless($_[0]);
  push(@_,$_[0]-1);
  hanoi(@_[-1,1,3,2,4]);
  $_[4]->(@_);
  hanoi(@_[-1,2,1,3,4]);
}
sub hanoi_print{
  my $t = shift;
  local $| = 1;
  select(undef,undef,undef,0.3);
  print "\e[1;1H";
  map { printf (" %2s %2s %2s\n",p2($t,$_))} (reverse (0 ..$n));
  printf (" %2s %2s %2s\n","-","-","-");
  printf (" %2s %2s %2s\n",@towers);
  print "\n";
}
sub p2{
  my ($t,$i) = @_;
  return map {$t->{$_}->[$i] ? $t->{$_}->[$i] : ' '} @towers;
}

 One Liner

モンテカルロ法で円周率を求めるワンライナー すぎゃんめもより

$  perl -lE 'for $i (1 .. pop){rand()**2+rand()**2 <=1 &&$x++; $i=~/^1[0]+$/ && say "$i,@{[$x*4/$i]}"}' 10000000
10,3.2
100,3.16
1000,3.164
10000,3.154
100000,3.13716
1000000,3.142384
10000000,3.1422264
$  perl -lE 'for $i (1 .. pop){rand()**2+rand()**2 <=1 &&$x++; $i=~/^1[0]+$/ && say "$i,@{[$x*4/$i]}"}' 10000000
10,2.8
100,3.24
1000,3.22
10000,3.1776
100000,3.15128
1000000,3.141972
10000000,3.1414164
$

ハノイの塔

perl -E 'sub h{return if(!$_[0]);push(@_,$_[0]-1);h(@_[-1,1,3,2,4]);$_[4]->(@_);h(@_[-1,2,1,3,4]);} h(pop,A..C,sub {say "$_[1]($_[0])=>$_[3]";})' 3

Oracle select

perl -MDBI -MData::Dumper -e "print Dumper (DBI->connect(q{dbi:Oracle:olcl},q{userName},q{password})->selectall_arrayref(q{select * from tabs where rownum < 5},+{Slice => +{}}));"

その他

perl -e "for my $i (glob(q{*019*})){ my $o; ($o = $i) =~ s/019/024/; rename($i,$o);}"

perl -MFile::Copy -e "my $i = q{InFile.xls}; for my $c (1 .. 100){ my $o; $c = sprintf(q{%03d},$c);($o = $i) =~ s/\d+/$c/; copy($i,$o) or die qq{copy($i,$o):$!}}"

ディレクトリ下の行数

$ tree -f |perl -alne '@x=split /\s+/,`wc -l $F[-1] 2>/dev/null`;$l=sprintf("%5d %s",$x[0],$_);$l=~ s/ 0 /   /;$l=~ s{\..*/}{};print $l'
      .
      ├── lib
      │   └── Tool
      │       ├── mmt
   13 │       │   ├── Example.pm
  512 │       │   └── Mmt.pm
   25 │       ├── mmt.pm
      │       ├── Model
   46 │       │   └── Webdb.pm
    7 │       └── Model.pm
      ├── log
 3979 │   └── development.log
      ├── public
   11 │   └── index.html
      ├── script
   11 │   └── toolmmt
    4 ├── svn-commit.tmp
      ├── t
    9 │   └── basic.t
      └── templates
          ├── example
    7     │   └── welcome.html.ep
          ├── layouts
    5     │   └── default.html.ep
          └── mmt
   27         ├── datalist.html.ep
    5         ├── desc.html.ep
   29         └── mainform.html.ep
      
      12 directories, 15 files
$

 Win32::OLE (2014/10/31)

windowsexcelを更新する

> perl excel_upd.pl A10   2014/10/31  xxxxxx.xls
                    ---   ----------  ----------
                     |         |         |
                     |         |         +------- 更新対象excel
                     |         +----------------- 更新内容
                     +--------------------------- 更新対象セル
[excelt_upd.pl]

use strict;
use Win32::OLE;

my ($cel,$value) = ($ARGV[0],$ARGV[1]);
for my $filename (glob($ARGV[2])) {
  print "[$filename]\n";
  excel_update($filename);
}

sub excel_update{
  my $file = shift;
  my $oBook = Win32::OLE->GetObject($file,sub {$_[0]->Quit;}) or die "$file:$!";
  $oBook->Windows(1)->{Visible} = 1;          # 次にexcelを開いたときに表示される様に

  my $oSheet = $oBook->Worksheets(1);
  $oSheet->range($cel)->{Value} = $value;
  $oBook->Save();
  $oBook->Close();
}

 WebSocket

僕の車輪の再発明で教えてもらったmojoliciousのwebsocketチャットを作ってみた。(写経しただけ。感謝!!)ubuntuChrome、Fierfox、androidChromeで動く事を確認しました。すごいねperl(mojolicious)。今度はチャボをwebsocket対応にしよう。[2014/4/14]チャボとお話出きるようになりました。

サンプル チャボ for WebSocket

#!/usr/bin/env perl
use utf8;
use Mojolicious::Lite;
use DateTime;
use Mojo::JSON;
use Mojo::UserAgent;
use Encode qw/from_to decode_utf8 encode_utf8 decode encode/;
use Data::Dumper qw/Dumper/;

get '/' => sub {
    my $self = shift;
} => 'index';

my $clients = {};
websocket '/echo' => sub {
    my $self = shift;

    Mojo::IOLoop->stream($self->tx->connection)->timeout(600);
    app->log->debug(sprintf 'Client connected: %s', $self->tx);
    my $id = sprintf "%s", $self->tx;
    app->log->debug("id:".$id);
    $clients->{$id} = $self->tx;

    $self->on(message => sub {
        my ($self, $msg) = @_;

        my ($name,$message) = split(/\t/,$msg);
        $self->app->log->debug('name: ', $name, 'message: ', $message);
        unless($name){
            $name = '名無し';
        }

        my $json = Mojo::JSON->new;
        my $dt   = DateTime->now( time_zone => 'Asia/Tokyo');

        # チャボに話しかける  --- START
        my $ua = Mojo::UserAgent->new;
        my $name_euc = decode_utf8($name);
        my $ans = $ua->get(Mojo::URL->new("http://www21051ue.sakura.ne.jp/chabo/chatbot_utf8.cgi?name=$name&action=TALK&chat=$message"))->res->body;
        my $txt = '';
        if($ans =~ m|<answer>(.*)</answer>|){
            $txt = decode('UTF-8',$1);
        }
        # チャボに話しかける  --- END

        for (keys %$clients) {
            $self->app->log->debug('clients', Dumper $clients->{$_});
            $clients->{$_}->send(
                decode_utf8($json->encode({
                    hms  => $dt->hms,
                    name => $name,
                    text => $message,
                }))
            );

            # チャボの話を拡散する  --- START
            if($txt ne ''){
                $clients->{$_}->send(
                    decode_utf8($json->encode({
                        hms  => $dt->hms,
                        name =>'チャボ',
                        text => $txt,
                    }))
                );
            }
            # チャボの話を拡散する  --- END
        }
    });

    $self->on(finish => sub {
        app->log->debug('Client disconnected');
        delete $clients->{$id};
    });
};

app->start;

__DATA__
@@ index.html.ep
% layout 'main';
%= javascript begin
jQuery(function($) {
  $('#msg').focus();

  // 1番下にスクロールする -- START
  var go_bottom = function(targetId){
    var $obj = $("#" + targetId);
    if ($obj.length == 0) return;
    $obj.scrollTop($obj[0].scrollHeight);
  };
  // 1番下にスクロールする -- END

  var log = function (text) {
    $('#log').val( $('#log').val() + text + "\n");
    go_bottom('log');
  };
  var ws = new WebSocket('<%= url_for('/echo')->to_abs->scheme('ws'); %>');
  ws.onopen = function () {
    log('Connection opened');
  };
  ws.onmessage = function (msg) {
    var res = JSON.parse(msg.data);
    log('[' + res.hms + '] (' + res.name + ') ' + res.text);
  };

  $('#msg').keydown(function (e) {
    if (e.keyCode == 13 && $('#msg').val()) {
        ws.send($('#name').val() + "\t" + $('#msg').val());
        $('#msg').val('');
    }
  });
    });
% end
<h1>Mojolicious + WebSocket</h1>
ここでの発言はチャボに記憶され何処かで引用される可能性が
有ります。ご注意下さい。
<textarea id="log" readonly></textarea>
<p>name<input type="text" id="name" /><br />msg<input type="text" id="msg" size="40"/></p>
[<%= url_for('/echo')->to_abs->scheme('ws'); %>]
<div>
</div>

@@ layouts/main.html.ep
<html>
  <head>
    <meta charset="<%= app->renderer->encoding %>">
    <title>WebSocket Client</title>
    %= javascript 'https://ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js'
    <style type="text/css">
      textarea {
          width: 40em;
          height:10em;
      }
    </style>
  </head>
  <body><%= content %></body>
</html>

 taro-nishinoの日記: 何故、私はJavaプログラマでないのか

http://slashdot.jp/journal/483065/%E4%BD%95%E6%95%85%E3%80%81%E7%A7%81%E3%81%AFJava%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%9E%E3%81%A7%E3%81%AA%E3%81%84%E3%81%AE%E3%81%8B

何故、私はJavaプログラマでないのか

Michael G Schwern

 

始めに、はっきり言っておかなければならない。このエッセイは、何故私がJavaプログラマでないのか、一個人の理由と考察に関するものである。それは、何故貴方がJavaプログラマでないのか、ではない。また、何故PerlJavaより優れているか、ではない。それはまた、何故Javaがそうなっている(私はほぼSunの設計方針により、そうなっているのを知っているが)のか、ではない。しかし、何故そうでないのか、理由を知ることは苛立ちを減らす。

.

.

"Hello World"は、一ステートメントであるべきである。

OOがすべてではない。

CPANが無い。

関数ポインターが無いことは、クロージャが無いことを意味する。

シンボルテーブルの操作が無い。

動的なメソッド生成が無い。

evalが無い。

多重継承が無い。

ヒアドキュメントが無い。

官僚的なプライバシールール。

強い型の強制。

.

.

.

結論。

 

Perlは簡潔な言語であり、アイデアをコードの中へ素早く簡単に投げるように設計されている。Javaは簡潔な文法で一貫性がある言語であり、よいスタイルを鼓舞し、組込み易く設計されている。どちらも強みと弱みを持っているが、人は滅多にどちらがどちらなのか一致しない。人はそのように可笑しいのである。或る者は、自分に制限を課して、自分自身から自分を救いたい。或る者は、出来るだけ制限を取り払い、自分自身になりたい。両者とも危険に満ちている。私は偶々後者の危険性を好んだのである。

 

Bjarne Stroustrupは以下のことを言ったことがある。

「我々が思考又はプログラミングする言語、問題、イメージ出来る解法の間の関係は非常に近い。この理由のため、プログラマのエラーを除去する特徴の言語を抑制することは結局危険である。」

 

しかし、Larry Wallはうまく要約していると私は思う。

Perlで汚いプログラムを書くことが可能であるという事実はまた、明晰さを強要する言語で書けたであろうプログラムよりも明晰なプログラムをPerlで書くことが可能であるということである。とてもいいことをする潜在能力は、とても悪いことをする潜在能力ともに進む。」

WSL2のvimでクリップボードを使う

基本的にはWSLのvimでクリップボードを使うと同じだがDISPLAYにlocalhostでは駄目でwindows10のIPを設定する

 1.vimを再インストール

クリップボードを使えるvimをインストールする。

  • vim --version|grep clipboard で -clipoardの場合はvimをインストールする。
  • sudo apt-get install vim-gtk
  • vim --version|grep clipboard で +clipoardを確認する。

 2.VcXsrvをインストール

VcXsrvをダウンロードしインストールする。

 3.環境変数DISPLAYの設定

ネット上では下記の様にnameserverのIPを拾えば良いと有るが私の環境では上手くいかない

LOCAL_IP=$(cat /etc/resolv.conf | grep nameserver | awk '{print $2}')
export DISPLAY=$LOCAL_IP:0

Windows側でIPを取得する事にした

DISPLAY=`ipconfig.exe|perl -nle 'print $1 if /IPv4.*(192[0-9.]*)/'`
export DISPLAY=${DISPLAY}:0

位置情報を取得(Geolocation API)

 JavaScriptで位置情報を取得

Webブラウザのgeolocationオブジェクトを使うと、JavaScriptで現在位置(緯度/経度/高度と移動中なら速度/方向)を取得することができます。サンプルを作ってみました。最初に位置情報を取得する許可を求められます。

 geolocation

geolocationは、Webブラウザ上のアプリケーション(JavaScript)で位置情報を利用するための仕組みです。navigatorが持つオブジェクトの形で実装され、現在ではパソコン用も含めほとんどのWebブラウザで利用できるようになっています。

 位置情報を取得するgetCurrentPosition()

getCurrentPosition()を呼び出すと、すぐに制御が返されます(次の文が実行される)。そして、位置情報の取得に成功すると、引数に渡した関数にPositionオブジェクトが渡されます。

Positionオブジェクトには、取得した位置情報と取得時間が格納されているので、その情報を使って処理を行うわけです。

navigator.geolocation.getCurrentPosition(success[, error[, [options]])

引数

  • success
    • コールバック関数で、GeolocationPosition オブジェクトを唯一の入力引数として受け取るものです。
  • error
    • 任意のコールバック関数で、GeolocationPositionError オブジェクトを唯一の入力引数として受け取るものです。
  • option
    • 任意の PositionOptions オブジェクトです。

 位置情報を取得し続けるwatchPosition()

watchPosition()は、getCurrentPosition()と同じ引数で呼び出しますが、呼び出した後は位置情報の更新があった時など継続的に位置情報が更新され、引数に渡した関数に通知されます。

 -

 SOURCE

<html lang="ja">
<head>
<meta charset=utf-8>
<script>
//ユーザーの現在の位置情報を取得
navigator.geolocation.getCurrentPosition(successCallback, errorCallback);

/***** ユーザーの現在の位置情報を取得 *****/
function successCallback(position) {
   var gl_text = "緯度:" + position.coords.latitude + "<br>";
       gl_text += "経度:" + position.coords.longitude + "<br>";
       gl_text += "高度:" + position.coords.altitude + "<br>";
       gl_text += "緯度・経度の誤差:" + position.coords.accuracy + "<br>";
       gl_text += "高度の誤差:" + position.coords.altitudeAccuracy + "<br>";
       gl_text += "方角:" + position.coords.heading + "<br>";
       gl_text += "速度:" + position.coords.speed + "<br>";
   document.getElementById("show_result").innerHTML = gl_text;
}

/***** 位置情報が取得できない場合 *****/
function errorCallback(error) {
   var err_msg = "";
   switch(error.code)
   {
       case 1:
           err_msg = "位置情報の利用が許可されていません";
           break;
       case 2:
           err_msg = "デバイスの位置が判定できません";
           break;
       case 3:
           err_msg = "タイムアウトしました";
           break;
   }
   document.getElementById("show_result").innerHTML = err_msg;
   //デバッグ用→ document.getElementById("show_result").innerHTML = 
error.message;
}
</script>
<title>Geolocation API サンプル</title>
</head>
<body>
<p>あなたの現在位置</p>
<div id="show_result"></div>
</body> 
</html>

WSLのvimでクリップボードを使う

windowsではXserverが無い為?にWSLのvimではクリップボードを共有する事が出来ません。Xserverを導入することでクリップボードを共有できる事を『WSL上のvimでクリップボードを共有する方法』で教えてもらいました。

   windowsにXserverを導入する

  1. ここ(VcXsrv Windows X Server)からVcXsrvをダウンロードしインストールする。
  2. インストールした「XLaunch」を起動する。(全てデフォルトでOK)
  3. .profileにexport DISPLAY=localhost:0.0を追加
  4. .vimrcにset clipboard=unnamedplusを追加

これでvimでyankした文字列をクリップボードに保存できwindowsアプリにてペースト(Ctrl+v)出来ます。また、windowsのアプリでコピー(Cirl+C)した文字列をvimにてペースト(pとか)できます。

   256倍便利

windowsアプリとクリップボードを共有出来るとやっぱり便利。てか、クリップボードを共有出来ないと不便すぎるでしょう。あっちこっちコピペは良くやりますから・・・

また、Xserverを導入する事で目玉や丸い時計を起動出来ます。

  • Xアプリインストール
    • sudo apt install x11-apps

カレンダー表示

 SOURCE

 menu.pm

sub panel_content{
    my $s = shift;
    my $m = $s->app->model;
    my $text = <<END_SCRIPT
   <pre>
   @{[`date +"%a %b %d %Y"`]}
   @{[$m->make_cal($m->today())]}
   </pre>
END_SCRIPT
}

 model.pm

sub make_days{
    my ($s,$y,$m,$d,$dumy) = @_;
    my @days = map{[$y,$m,$_]} (1 .. $s->end_day($y*100+$m));
    my $w = $s->getwday($y,$m,$s->end_day($y*100+$m));
    my ($yy,$mm,$dd) = (0,0,0);
    for ($w+1 .. 6){
        ($yy,$mm,$dd) = $s->adddate($y,$m,$s->end_day($y*100+$m),$dd+1);
        push(@days,[$yy,$mm,$dd]);
    }
    $d = 1;
    $w = $s->getwday($y,$m,$d);
    while($w--){
        ($y,$m,$d) = $s->adddate($y,$m,$d,-1);
        unshift(@days,[$y,$m,$d]);
    }
    return @days;
}
sub make_cal{
    my ($s,$y,$m,$d,$dumy) = @_;
    my $cal = '';
    $cal .= "<table border=0 width=50%>";
    $cal .= $s->tag("tr",$s->tag("td",qw(日 月 火 水 木 金 土)));
    my $i = 0;
    $cal .= join ("",map {$s->day_class($i++,$y,$m,$_) } $s->make_days($y,$m,$d));
    $cal .= "</table>";
    return $cal;
}
sub day_class{
    my ($s,$i,$y,$m,$d) = @_;
    my $text ='';
    my $class = $s->holiday(-date=>$d->[0]*10000+$d->[1]*100+$d->[2]);
    if($class ne ''){
        $class = 'hol';
    }else{
        $class = qw(Sun Mon Tue Wed Thu Fri Sat)[$i % 7];
    }
    $class .= ' today' if ($s->isToday($d->[0],$d->[1],$d->[2]));
    $class = 'Non' if($m != $d->[1]);
    $text .= '<tr>' if($i % 7 == 0);
    $text .= qq{<td class="$class">$d->[2]</td>};
    $text .= '</tr>' if($i % 7 == 6);
    return $text;
}
#------------------------------------------------------------------
sub holiday{
#------------------------------------------------------------------

=head2 祝日計算 [holiday]

=over 2

祝日なら祝日の名前を返す

=item $name = holiday(-date=>YYYYMMDD)

 西暦年月日より祝日の判断を行う

=back

=cut

    my $s = shift;
    my %x = (
        1 => {1 => "元旦",},
        2 => {11 => "建国記念日",
            23 => "天皇誕生日"},
        4 => {29 => "昭和の日",},
        5 => {3 => "憲法記念日",
            4 => "みどりの日",
            5 => "こどもの日",},
        8 => {11 => "山の日",},
        11 => {3 => "文化の日",
            23 => "勤労感謝の日",},
        @_);
    my($y,$m,$d) = $s->ymd_split($x{-date});
    $m = $m+0;
    $d = $d+0;
    $x{1}{$s->get_w_day($y,1,2,1)} = "成人の日";
    $x{7}{$s->get_w_day($y,7,3,1)} = "海の日";
    $x{9}{$s->get_w_day($y,9,3,1)} = "敬老の日";
    $x{10}{$s->get_w_day($y,10,2,1)} = "スポーツの日";
    my ($vernal,$autumnal)=$s->get_equinox_day($y);
    $x{3}{$vernal} = "春分の日";
    $x{9}{$autumnal} = "秋分の日";
    my($yy,$mm,$dd) = $s->adddate($y,$m,$d,-1);
    if($s->getwday($yy,$mm,$dd) == 0 and defined $x{$mm}{$dd}){
        $x{$m}{$d} = "振替の休日";
    }
    if($s->getwday($yy,5,5) <= 2){
        $x{5}{6} = "国民の休日";
    }
    return $x{$m}{$d};
}
#------------------------------------------------------------------
sub get_w_day{
#------------------------------------------------------------------

=head2 $y年$m月第$n曜日の日を返す [get_w_day]

=over 2

=item $d = get_w_day($y,$m,$n,$wday)

 $y: 年
 $m: 月
 $n: 第何曜日かを指定[1&#12316;5]
 $n: 曜日 [0&#12316;6] (0:日曜 1:月曜 2:火曜 3:水曜 4:木曜 5:金曜 6:土曜)
 $d: 対象の日付を返す

=back

=cut

   my $s = shift;
   my ($y,$m,$n,$wday) = @_;
   my $st_wday = $s->getwday($y,$m,1);
   my $end_day = $s->end_day($y*100+$m);
   my $d;
   if($wday >= $st_wday){$n--;}
   $d = 7 * $n + $wday + 1 - $st_wday;
   if($d > $end_day or $d <= 0){$d = '';}
   return $d;
}
#------------------------------------------------------------------
sub get_equinox_day{
#------------------------------------------------------------------

=head2 春分の日秋分の日を求める [get_equinox_day]

=over 2

 指定した年の春分日・秋分日をもとめる
(1980年から2099年に適用)
 ($vernal,$autumnal)=get_equinox_day($y);

=back

=cut

    my $s = shift;
    my ($yy)=@_;
    my ($vernal) = int(20.8431+0.242194*($yy-1980)-int(($yy-1980)/4));
    my ($autumnal)=int(23.2488+0.242194*($yy-1980)-int(($yy-1980)/4));

    return ($vernal,$autumnal);
}
#------------------------------------------------------------------
sub end_day{
#------------------------------------------------------------------

=head2 末日算出 [end_day]

=over 2

入力年月から末日を計算する。

=item $day = end_day($DATE)

 $DATE: 日付 YYYYMM or YYYY/MM
 $day: $DATEの末日(28or29or30or31)

=back

=cut
   my $s = shift;
   my $yymm = shift;
   my @end = (31,28,31,30,31,30,31,31,30,31,30,31);
   $yymm =~ /^(\d{1,4})\D*(\d{1,2})$/;
   my ($y,$m) = ($1,$2);
   if($2 != 2){return $end[$m - 1];}
   if($y % 400 == 0 or $y % 100 != 0 and $y %4 == 0){
       return 29;
   }else{  return $end[$m - 1];}
}

 demo.css

.Sun{color:RED;}
.Sat{color:BLUE;}
.hol{color:RED;}
.today{
    box-shadow:  3px 3px 7px 1px rgba(0,0,0,0.4);
    transform: scale(1.05,1.05);
}
.Non{color:GRAY;}

ツェラーの公式(Zeller's congruence):曜日計算

ツェラーの公式(ツェラーのこうしき、英: Zeller's congruence)とは西暦(グレゴリオ暦またはユリウス暦)の年・月・日から、その日が何曜日であるかを算出する公式である。クリスティアン・ツェラー (Christian Zeller) が考案した。ユリウス通日を求め、そこから曜日を求める計算と本質は同じである。ウィキペディア(Wikipedia)より

 ツェラーの公式の導出

ツェラーの公式はフェアフィールド (Fairfield) の公式の変形である。

 フェアフィールドの公式

1年1月1日(0年13月1日) ~ y 年 m 月 d の日数を求める。ただし、m = 1, 2 の場合は、y = y - 1, m = m + 12とし、1年を、3月1日 ~ 14月28日(閏年は29日)と再定義する。

1年1月1日(0年13月1日)を含めた、y 年 m 月 d 日迄の日数は以下の通り。

 1年1月1日(0年13月1日) ~ 1年2月28日(0年14月28日)

  ・・・  31 + 28 (日)

 1年3月1日 ~ ( y - 1 ) 年14月末日(この時点では閏年は考慮しない)

  ・・・  365 ( y - 1 ) (日)

 1年1月1日(0年13月1日) ~ ( y - 1 ) 年14月末日の閏年の回数

  ・・・  [ ( 1 + ( y - 1 ) ) / 4 ) ] - [ ( 1 + ( y - 1 ) ) / 100 ) ] + [ ( 1 + ( y - 1 ) ) / 400 ) ]

      = [ y / 4 ] - [ y / 100 ] + [ y / 400 ] (日)

 y年3月1日 ~ y 年 ( m - 1 ) 月末日

  ・・・  [ 306 ( m + 1 ) / 10 ] - 122 (日) (以下表を参照)

 y 年 m 月1日 ~ y 年 m 月 d 日

  ・・・  d (日)

 3月1日 ~ ( m - 1 )月末日迄の日数と、[ 306 ( m + 1 ) / 10 ] - 122 の値は完全に一致している。

当月(m) 前月(m-1) 日数(Σ) [306(m+1)/10]-122
3   0 0
4 3 31 31
5 4 61 61
6 5 92 92
7 6 122 122
8 7 153 153
9 8 184 184
10 9 214 214
11 10 245 245
12 11 275 275
13 12 306 306
14 13 337 337

従って、1年1月1日 ~ y 年 m 月 d 日の日数は、上記全てを合算した、

  31 + 28 + 365 ( y - 1 ) + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ 306 ( m + 1 ) / 10 ] - 122 + d

曜日は7日間で循環しているので、上記【※】式の 7 の剰余を求めることで、曜日が判明する。即ち、

  h = ( 365y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ 306 ( m + 1 ) / 10 ] d - 428 ) mod 7 ・・・【I】

 ツェラーの公式への変形

【I】式が 7 の剰余である事を利用すると、以下の通り変形できる。

  h = ( 7 ( 52 y - 62) + y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ 153 ( m + 1 ) / 5 ] + 6 + d ) mod 7

   = (          y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ 153 ( m + 1 ) / 5 ] + 6 + d ) mod 7

ここで、[ ] (ガウス記号)の性質( [ a ] + b = [ a + b ] , ただし b は整数)を利用すると、

  h = ( y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ 153 ( m + 1 ) / 5 + 6 ] + d ) mod 7

   = ( y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ ( 153 m + 153 + 30 ) / 5 ] + d ) mod 7

   = ( y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ ( 153 m + 183 ) / 5 ] + d ) mod 7

   = ( y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ ( 35 ( 4 m + 5 ) + 13 m + 8 ) / 5 ] + d ) mod 7

   = ( y + [ y / 4 ] - [ y / 100 ] + [ y / 400 ] + [ 7 ( 4 m + 5 ) + ( 13 m + 8 ) / 5 ] + d ) mod 7

さらに、h が 7 の剰余であることを利用して、 ・ ・ ・

 実装してみる

sub getwday{
   my $s = shift;
   my($year, $mon, $mday) = @_;

   if ($mon == 1 or $mon == 2) {
       $year--;
       $mon += 12;
   }
   return int($year + int($year / 4) - int($year / 100) + int($year / 400)
       + int((13 * $mon + 8) / 5) + $mday) % 7;
}