2009/01/07


im.kayac.comに送信するperlスクリプト。
コードだけ。
#!/usr/bin/perl
use strict;
use warnings;

use Encode;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use Config::Pit;
use Digest::SHA1 qw(sha1_hex);
use JSON;

if ($^O eq 'MSWin32') {
    eval {
        require Win32::API;
        Win32::API->Import('kernel32', 'UINT GetACP()');
        Encode::from_to($ARGV[0], 'cp'.GetACP(), 'utf-8');
    };
}

my $config = pit_get("im.kayac.com", require => {
        "username" => "your username on im.kayac.com",
        "password" => "your password(or secretkey) on im.kayac.com",
        "authtype" => "auth type on im.kayac.com: none/password/secretkey",
    });

my %data = ( message => shift );
die "should be specify message" unless $data{message};
$data{password} = $config->{password} if $config->{authtype} eq "password";
$data{sig} = sha1_hex($data{message} . $config->{password}) if $config->{authtype} eq "secretkey";

my $ua = LWP::UserAgent->new;
my $res = from_json($ua->post(
    "http://im.kayac.com/api/post/$config->{username}", \%data,
    "Content-Type" => "application/x-www-form-urlencoded"
)->decoded_content);

print $res->{result}.$res->{error};
Posted at by



2008/12/18


Perlerと呼ばれる程のスキルは無いのですが...
Perlプログラマーの皆さん - Perl入門~サンプルコードによるPerl入門~

Perlをやっている人のブログをRSSリーダーに登録しておくと最新の事情がわかったりします。

http://d.hatena.ne.jp/perlcodesample/20081217/1229522517
Plaggerで上記リンクからOPML作るYAML書きました。
perler-in-japan.yaml
plugins:
  - module: Subscription::XPath
    config:
      url: http://d.hatena.ne.jp/perlcodesample/20081217/1229522517
      xpath: //div[@class="body"]/div[@class="section"]/blockquote/p/a

  - module: Publish::OPML
    config:
      filename: perler-in-japan.opml
出来上がったOPMLも置いておきます。2008/12/17 14:30:00時点のOPMLです。
Plagger Subscriptions - Perler in Japan
よろしければどうぞ。
Posted at by



2008/12/17


いつも面倒臭いなぁと思いながらブラウザでログインしてバージョン書いたりしてたんですが、勢い余ってスクリプトを書いてしまいました。
使い方は # vim-release.pl -sv=<スクリプトのバージョン> -vv=<vimのバージョン> -msg=<メッセージ> <ファイル>
です。-vvを省略すると7.0が、-msgを省略すると入力プロンプトが表示されます。ユーザおよびパスワードはConfig::Pitで管理します。
実際には、このスクリプトの-svを省略する為の補助が欲しい所ですが、前のバージョンから+1では不味いし、スクリプトから調べるのは無理があるし...で引数にしました。
おそらく私くらいしか使わないかと思いますが、よろしければどうぞ。
gist: 36989 — GitHub
#!perl
use strict;
use warnings;
use Config::Pit;
use Getopt::Long;
use WWW::Mechanize;
use Perl6::Say;

my $conf = pit_get("vim.com", require => {
  "username" => "your username on vim.org", # NOTE: do not edit this line
  "password" => "your password on vim.org", # NOTE: do not edit this line
});

my %args = ( id => '', sv => '', vv => '7.0', msg => '' );
die "invalid args"
  unless GetOptions(\%args, 'id=i', 'sv=s', 'vv=f', 'msg=s');
unless ($args{msg}) {
  print "message: ";
  $args{msg} = <STDIN>;
}

my $file = shift;
die "script version not specified" unless $args{id};
die "message not specified" unless $args{msg};
die "file not specified" unless $file;

my $mech = WWW::Mechanize->new;
$mech->get('http://www.vim.org/login.php');
$mech->submit_form(
    form_name => 'login',
    fields    => {
        userName => $conf->{username},
        password => $conf->{password},
    },
);

$mech->get("http://www.vim.org/scripts/add_script_version.php?script_id=$args{id}");
$mech->form_name('script');
$mech->field(script_file => $file);
$mech->select('vim_version', $args{vv});
$mech->field(script_version => $args{sv});
$mech->field(version_comment => $args{msg});
my $res = $mech->click('add_script');
say $res->is_success ? "uploaded" : $res->status_line;
Gist.vim version 1.1 への更新で上手く動いてそげです。
Posted at by