plamo8.2x->perl

perl

実行オプション

既存ファイルの文字列を置換して、元のファイルを上書きする

$ perl -pi -e 's/[source]/[destination]/' [file] [参考]

セットアップ

perl 5.40.1

必要があって 5.40.1 を入れました。 ソースアーカイブを持ってきて入れ直します。

$ tar zxvf perl-5.40.1.tar.gz
$ cd perl-5.40.1
$ ./Configure -des
$ make
$ make test
# make install

大抵のスクリプトは /usr/bin/perl を決め打ちしているので、今回入れた /usr/local/bin/perl へのリンクで置き換えておきます。

# cd /usr/bin
# mv perl _perl
# ln -s /usr/local/bin/perl .

CPANはもう一回セットアップしなおすことになります。

CPAN

モジュールをダウンロードしてインストールしてくれます[→参考]

最初に使うときには色々と設定を訊かれますが、あとは依存関係を考慮して必要なものをダウンロードしてセットアップしてくれます。

使ってみるとなかなかラクです。debianもこんな感じなのでしょうか。

cpanmを入れる

最初に使うときには色々と設定が必要なのですが、automaticを選ぶと何もすることがありません # perl -MCPAN -e shell

まずはCPANの代替ツールとしてcpanminusを入れてみます。依存関係を見て必要なものも入れてくれるので楽ちん。

これはCPANを使ってセットアップします。 # cpan
cpan[1]> install App::cpanminus
# cpan の代わりに # cpanm が使えるようになります。

使い方

[参考] [参考]
  1. モジュール Getopt::Long をインストールする # cpanm Getopt::Long
  2. モジュール Getopt::Long をテストを省略しつつインストールする # cpanm --notest Getopt::Long
  3. モジュール Getopt::Long を強制的にインストールする # cpanm --force Getopt::Long

モジュールのセットアップでエラーになる

ビルドは上手くいってるのにテストでエラーになっていることがあります。 メモリが不足していたり、ネットワークが接続できなかったり(相手が消滅していることがある)しているようです

モジュールの依存関係がある程度解決しているようなら、アーカイブを自分でダウンロードして手動でセットアップする(テストをしない)方法があります。

$ perl Makefile.PL
$ make
($ make test)←ここを省略
# make install

大抵は --force オプションで対応できてしまいますが。

misskeyへ投稿

perlでmisskeyへ投稿します。

公開されているAPIを使います。 cpanには見当たらなかったので、LWP::UserAgent 等を直接使っています。 [参考]

画像つき投稿

画像つき記事の投稿だけ作りました。下記のような流れになります。

  1. /drive/files/create で画像をアップロードして、画像ファイルのIDを受け取る。
  2. /notes/create で、本文と画像ファイルのIDを送る。

なお、事前の準備として、アクセストークンを取得しておく必要があります。

使っているものを少し整理したものを載せておきます。

#!/usr/bin/perl

use strict;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request::Common;

use utf8;
use JSON; # true : \1, false \0

# usage:
#
# my @ids = &misskey_upload_files("img_3918.jpg","ix4_0439_banner.jpg");
# my $ret = &misskey_create_note( "TEST", @ids );
# if( $ret eq "" ){ print "Fail.\n"; }
# exit;

#-----------------------------------
# 日記を作成する
#  $string : 本文テキスト
#  @fileids : 掲載画像( misskeyドライブのファイルID の配列 )
#
sub misskey_create_note {
    my ( $string, @fileids ) = @_;

    my $json = JSON->new->utf8();
    my $data_notes = {
	#visibility => "specified", # 特定の人にしか見せない → テスト中は有効にしておく
	text => $string,
	# channelId => '(チャンネル投稿の場合)',
    };

    my %seen;
    my $uqfileids = grep { ! $seen{ $_ }++ } @fileids; # 重複を取り除く(重複が有るとエラーになる)

    for( my $i=0 ; $i<@uqfileids ; $i++ ){
	$data_notes->{mediaIds}->[$i] = $uqfileids[$i]; # mediaIds と fileIds の違いがわからない...
    }
    #print Dumper $data_notes;

    my %misinfo = &misskey_userinfo();
    my $rp = POST(
	"$misinfo{'baseurl'}notes/create",
	Content_Type => 'application/json',
	User_Agent => $misinfo{'useragent'},
	Authorization => "Bearer $misinfo{'token'}",
	Content => $json->encode($data_notes)
	);
    #print Dumper $rp;

    my $ua = LWP::UserAgent->new; # You might want some options here
    my $res = $ua->request($rp);
    if( $res->is_success){
	my $rdata = $json->decode( $res->content );
	print "[success: ContentID : $rdata->{createdNote}->{id}]\n";
	#print Dumper $rdata;

	return $rdata->{createdNote}->{id};
    }else{
	print "[error : $res->status_line ]\n";
    }
    return "";
}


# ファイルをアップロード( 複数ファイル )
sub misskey_upload_files()
{
    my( @files )= @_;
    my %seen;
    my @uqfiles = grep { ! $seen{ $_ }++ } @files; # 重複を取り除く
   
    my @fileids;
    for( my $i=0, my $j=0 ; $i<@uqfiles ; $i++ ){
	my $id = misskey_upload_file( $uqfiles[$i] );
	if( $id ne "" ){
	    # print "$files[$i] : $id\n";
	    $fileids[$j] = $id;    $j++;
	}
    }
    return @fileids;
}


# ファイルをアップロード( 1ファイル )
sub misskey_upload_file()
{
    my( $file )=@_;

    my %misinfo = &misskey_userinfo();
    my $rp = POST(
	"$misinfo{'baseurl'}drive/files/create",
	Content_Type => 'multipart/form-data',
	User_Agent => $misinfo{'useragent'},
	Authorization => "Bearer $misinfo{'token'}",
	Content => { file => [ $file ] }
	);

    my $ua = LWP::UserAgent->new; # You might want some options here
    my $ret = $ua->request($rp);

    if ($ret->is_success) {
	my $json = JSON->new->utf8;
	my $rdata = $json->decode($ret->content);
	print "upload success :$rdata->{id}, $rdata->{name}\n";
	#print Dumper $rdata;
	
	return $rdata->{id};

    }else{
	print "misskey_upload_file() false : $ret->status_line \n";

    }
    return "";
}

# アクセス用の色々を返す
sub misskey_userinfo()
{
    my %info = (
	baseurl => '(APIのアドレスを記載します。misskey.ioの場合は https://misskey.io/api/ )',
	token => '(取得したアクセストークンを記載します)',
	useragent =>'xxxxxxxxxxxxx'
	);
    return %info;
}

blueskyへ投稿

perlでblueskyへ投稿します。

cpan から blueskyモジュールを使います。perl 5.40 が必要です。 blueskyモジュールについては、cpanドキュメントに載ってる使い方と、実際の使い方は何か違う感じがします。

画像つき投稿

画像つき記事の投稿だけ作りました。 画像ファイルは1Mバイト/ファイルが上限。また1記事につき4個が上限で、これを越えるとエラーになるため、前処理込みです。

使っているものを少し整理したものを載せておきます。

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
#use utf8;
#use Encode; 
#our $MC = 'utf-8'; # 外部文字コード

use Bluesky;
use Image::Magick;

#### example
#my @imgfile;
#$imgfile[0] = '';
#$imgfile[1] = 'img02.jpg';
#$imgfile[2] = 'img13.jpg';
#$imgfile[3] = 'img02.jpg';
#$imgfile[4] = 'img05.jpg';
#$imgfile[5] = 'img14.jpg';
#$imgfile[6] = 'img03.jpg';
#$imgfile[7] = 'img03.jpg';
#
# ファイルの制限に掛かると投稿されない
# ( ファイルサイズ 1,000,000バイトまで・ファイル数 4つまで )
# → 内部でチェックしてファイルサイズの縮小に挑戦してみたうえで、投稿ファイルを絞って投稿する。
#   (エラーにはしない。)
#
#my $ret = bluesky_create_post( 'こんにちは(TEST)', @imgfile );
#exit;
#
####

sub bluesky_create_post {
    my ( $string, @imgfiles ) = @_;
    my ( $ret );
    # ---------- 投稿がエラーにならないための最小限の処理だけ
    # --- 重複取り除く
    my( %seen );
    my @uqfiles = grep { ! $seen{ $_ }++ } @imgfiles; # 重複を取り除く

    # 画像ファイルの制限チェック( ファイルサイズ 1,000,000バイトまで・ファイル数 4つまで )
    # → 配列の先頭から、ファイルサイズを満たすファイルを4つまで抜き出す
    my( @sendfiles, $n );
    $n=0;
    foreach my $file ( @uqfiles ){
	if( -s $file > 950000 ){
	    $file = resize_image_1M( $file );
	}
	if(( -r $file )&&( -s $file < 1000000 )){
	    $sendfiles[$n++] = $file;
	    if( $n >= 4 ){ last; }
	}
    }

    my %postpara = (
	embed => { images =>[@sendfiles] },
	lang => 'ja',
	text => $string );

    my %ui = bluesky_userinfo();

    print "toBluesky ...\n";
    my( $bsky, $bret );
    $bsky = Bluesky->new();
    $bsky->login( $ui{user}, $ui{token} );

    {   # Bluesky.pm でエラー出力がある(実害なし?)ので抑制しておく
	local *STDERR;
	open STDERR, '>', undef;
	$bret = $bsky->createPost( %postpara );
    }
	
    if( ref($bret) eq "At::Error" ){
    	print "[error: $bret]\n";
        $ret = 0;
    }else{
	print "[success: cid= $bret->{cid}]\n";
	$ret = 1;
    }
    return $ret;
}
    

# アクセス用の色々を返す
sub bluesky_userinfo()
{
    my %info = (
	user => '(userid)',
	token => '(accesstoken)'
	);
    return %info;
}

sub resize_image_1M
{
    my ( $file ) = @_;

    my $rsize = -s $file;
    if( $rsize < 1000000 ){ # ファイルサイズが大きすぎない → とくに処理は必要ない
	# print "$file : OK\n";
	return( $file );
    }

    #-------------------------- ファイル名を変える
    $file =~ /^(.+)\.([^\.]+)$/;
    my $nfile = "${1}m.${2}";

    for( my $i=1 ; $i < 10  ; $i++ ){
	if( -e $nfile ){
	    $nfile = "${1}m${i}.${2}";
	}else{
	    last;
	}
    }

    #-------------------------- 縮小(画素数を下げる)
    my( $image, $ret );
    $image = Image::Magick->new;
    $ret = $image->Read( $file );

    my( $width, $height, $newwidth, $newheight );
    $width = $image->Get('columns');
    $height=$image->Get('height');
    
    my $ratio = int(sqrt(950000/$rsize)*10)/10; # 解像度を10%単位で落とす
    $newwidth = int($ratio * $width);
    $newheight = int($ratio * $height);

    my $geo = "${newwidth}x${newheight}";
    $ret = $image->Resize(geometry=>$geo);

    if($ret = $image->Write( $nfile )){
	return "";
    }
    #my $nrsize = -s $nfile;
    #print "$file ($width x $height : $rsize ) -> $nfile ( $newwidth x $newheight : $nrsize )\n";

    return( $nfile );
}

1;

Xへ投稿

perlでXへ投稿します。

api v2 を使うことになりますが、画像ファイルのアップロードは api v1.1 を使います。 Twitter::APIモジュールを使います。

画像つき投稿

画像つき記事の投稿だけ作りました。 といってもネットで拾って投稿できたサンプルスクリプトを少し整理しただけです。 API v1 以前の情報はあるのですが、v2での投稿はサンプルが少なくて困りました。 APIそのものも Twitter::APIモジュールも過渡期のまま止まってるみたいで、正直言ってパラメーターの意味とかよくわかってません。

#!/usr/bin/perl
##
## https://pawafuru.com/0445 より
##
use strict;
use warnings;
use Data::Dumper;

use Twitter::API;
use utf8;

# usage:
#
# my @ids = &xapi_upload_files("img03.jpg","img04.jpg");
# my $ret = &xapi_create_note( "TESTv2", @ids );
# if( $ret eq "" ){ print "Fail.\n"; }else{ print "$ret\n"; }
#
# exit;

#-----------------------------------
# 日記を作成する
#  $string : 本文テキスト
#  @fileids : 掲載画像( Xへuploadしたファイルの IDの配列 )
#
sub xapi_create_note {
    my ( $string, @fileids ) = @_;

    my %apiinfo = &xapi_userinfo();
    my $twitter = Twitter::API->new_with_traits(
	api_version => '2',
	api_ext => '',
	traits => [qw/RetryOnError/],
	consumer_key    => $apiinfo{consumer_key},
	consumer_secret => $apiinfo{consumer_secret},
	access_token => $apiinfo{access_token},
	access_token_secret => $apiinfo{access_token_secret},
	);

    #------------------------------
    my %dm = ( text => $string );
    my %da;
    if( @fileids>0 ){
	
	my %seen;
	my @uqfileids = grep { ! $seen{ $_ }++ } @fileids; # --- 重複を取り除く

	my @twids;
	for( my $i=0 ; $i<@uqfileids ; $i++ ){ # --------------- 上限4つ
	    if( $i>=4 ){ last; }
	    $twids[$i] = $uqfileids[$i];
	}
	%dm = ( %dm, media =>{ media_ids => \@twids });
    }
    my $rqpara = { -to_json => \%dm };
    #print Dumper \$rqpara;
    #return;

    #------------------------------
    my $ret = $twitter->request( post => 'tweets', $rqpara );
    #print Dumper $ret;
    
    if( exists( $ret->{data}->{id} )){
	if( length( $ret->{data}->{id}) > 0 ){
	    return $ret->{data}->{id};
	}
    }
    return "";
}


# ファイルをアップロード( 複数ファイル )
sub xapi_upload_files()
{
    my( @files )= @_;
    my %seen;
    my @uqfiles = grep { ! $seen{ $_ }++ } @files; # 重複を取り除く

    my @fileids;
    for( my $i=0, my $j=0 ; $i<@uqfiles ; $i++ ){
	print "($i) $uqfiles[$i] ..";
	my $id = xapi_upload_file( $uqfiles[$i] );
	if( $id ne "" ){
	    print ".. $id\n";
	    $fileids[$j] = $id;
	    $j++;
	    if( $j>=4 ){ last; }    # アップロード数を制限する
	}
    }
    return @fileids;
}


# ファイルをアップロード( 1ファイル )
sub xapi_upload_file()
{
    my( $file )=@_;

    if(!( -f $file )){ return 0; }
    
    my %apiinfo = &xapi_userinfo();

    my $twitter = Twitter::API->new_with_traits(
	api_version => '1.1',
	api_ext => '.json',
	traits => [qw/Migration ApiMethods RetryOnError/],
	consumer_key    => $apiinfo{consumer_key},
	consumer_secret => $apiinfo{consumer_secret},
	access_token => $apiinfo{access_token},
	access_token_secret => $apiinfo{access_token_secret},
	);

    my $media = [ $file ]; # 配列で与えるので複数まとめてでも良い?
    my $ret = $twitter->upload_media( $media );
    #print "000000\n";
    #print Dumper $ret0;

    if( exists( $ret->{media_id_string} )){
	if( length( $ret->{media_id_string}) > 0 ){
	    return $ret->{media_id_string};
	}
    }
    return 0;
}
    

sub xapi_userinfo()
{
    my %info = (
	consumer_key    => 'xxxxxxxxxxxxxxxxxxx',
	consumer_secret => 'xxxxxxxxxxxxxxxxxxxxxxxxxxx',
	access_token => 'xxxxxxxxxxxxxxxxxxxxxxxxxxx',
	access_token_secret => 'xxxxxxxxxxxxxxxxxxxxxxxxxx',
	Client_ID => 'xxxxxxxxxxxxxxxxxxxx',
	Client_Secret => 'xxxxxxxxxxxxxxxxxxxxx',
	useragent =>'xxx',
	);
    return %info;
}

1;

tsushiro.s, 2003-2025.