Twitter フォロワー同期(フォロー専用)Bot Perl 新API対応(改弐)
1月 16, 2014 — 18:01

TwitterのAPIがすべてSSLになり403 forbiddenと表示されるようになったので対策してみました。

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

# モジュール使用宣言
use Encode;
use FindBin;
use YAML::Tiny;
use Array::Diff;
use Net::Twitter;

# 現在のパスから見て設定ファイルを読み込み
my $config = (YAML::Tiny->read($FindBin::Bin . '/config.yml'))->[0];

# OAuth認証
my $twitter = Net::Twitter->new(
        traits           => ['API::RESTv1_1', 'OAuth'],
        consumer_key     => $config->{'consumer_key'},
        consumer_secret  => $config->{'consumer_secret'},
        apiurl           => 'https://api.twitter.com/1.1',
        searchapiurl     => 'https://api.twitter.com/1.1',
        legacy_lists_api => 0
);

$twitter->access_token($config->{'access_token'});
$twitter->access_token_secret($config->{'access_token_secret'});

# 認証失敗時の処理
die('Auth failed:'.$config->{'username'}) unless ( $twitter->authorized ) ;

# ユーザー名を含むユーザー情報を取得
my $own_id = $twitter->verify_credentials->{id};

my $nextc = -1; # paging default.
my @following_id_list; # outgo

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
        # パラメータcursorは前回取得したフォローイングまでの番号が入っている
        my $following_list = $twitter->friends_ids({ id=>$own_id, cursor => $nextc });
        $nextc = $following_list->{next_cursor};
        # 配列からフォローイングのidを取得
        foreach my $id (@{ $following_list->{ids} }){
                push(@following_id_list, $id); # 後で比較するためにフォローイングを配列に保管
        }
}while($nextc!=0);
# 文字昇順でソート
@following_id_list = sort @following_id_list;

$nextc = -1;
my @followers_id_list; # income

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
        # パラメータcursorは前回取得したフォロワーまでの番号が入っている
        my $followers_list = $twitter->followers_ids({ id=>$own_id, cursor => $nextc });
        $nextc = $followers_list->{next_cursor};
        # 配列からフォロワーのidを取得
        foreach my $id (@{ $followers_list->{ids} }){
                push(@followers_id_list, $id); # 後で比較するためにフォロワーを配列に保管
        }
}while($nextc!=0);
# 文字昇順でソート
@followers_id_list = sort @followers_id_list;

# 差分を取得(フォローイング)
my $diff_following = Array::Diff->diff(\@following_id_list, \@followers_id_list);

# 差分を取得(フォロワー)
my $diff_followers = Array::Diff->diff(\@followers_id_list, \@following_id_list);

# リムった人をリム返し
foreach my $delid_following (@{ $diff_following->{deleted} }){
        eval{$twitter->destroy_friend({user_id => $delid_following})};
        # プライベートだとエラーになる人がいるので確認用
        print $delid_following . "\n" if($@);
}

# フォローした人をフォロー返し
foreach my $delid_followers (@{ $diff_followers->{deleted} }){
        eval{$twitter->create_friend({user_id => $delid_followers})};
        # プライベートだとエラーになる人がいるので確認用
        print $delid_followers . "\n" if($@);
}
Perl SSH接続 Net::SSH2 使い方 CentOS5
11月 20, 2013 — 10:51

PerlでSSHへ接続したくなったのでNet::SSH2を使ってみた
Net::SSH2を使うにはlibssh2-develを使用するらしいのでインストール
# yum -y install libssh2-devel

cpanを使ってNet::SSH2をインストール
# cpan -i Net::SSH2
# cpan -i Net::OpenSSH::Compat::SSH2

実装例
SSHでサーバにログインしてpublic_htmlに移動し、lsコマンドを実行する

#!/usr/bin/perl
use strict;
use warnings;
# SSHのバナーを表示したい場合
#use Net::OpenSSH::Compat::SSH2 qw(:supplant);
use Net::SSH2;

# バッファーサイズ
use constant BUFLEN => 512;

my $host = ""; # 接続先ホスト
my $user = ""; # ユーザ名
my $pass = ""; # パスワード

my ($len, $buf);

my $ssh2 = Net::SSH2->new();

$ssh2->connect($host) or die "$!";

if( $ssh2->auth_password($user,$pass)) {
    my $chan = $ssh2->channel();
    $chan->blocking(0);
    $chan->shell();

    $chan->write("cd public_html\n");
    select(undef,undef,undef,0.2);
    print $buf while ($len = $chan->read($buf, BUFLEN));

    $chan->write("ls -al ./\n");
    select(undef,undef,undef,0.2);
    print $buf while ($len = $chan->read($buf, BUFLEN));

    $chan->close();
}

これは色々使えそうですね

参考サイト
Perl Tips | Perl で、ssh でリモートのサーバにアクセスしてファイルをアップロード(SCP)する方法 (Net::SSH2)
自分イノベーション – 気まぐれ勉強メモ Net::SSH2を使ってみた
Net::SSH2と公開鍵
A little demo for Net::SSH2

Twitter フォロワー同期(フォロー専用)Bot Perl 新API対応(改)
10月 5, 2013 — 8:45

アカウントがプライベート設定のフォロワーがいると403 forbiddenになって処理が止まるようなので一応対策しました
手動で実行することで対象のID(数字)を確認出来ます

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

# モジュール使用宣言
use Array::Diff;
use Net::Twitter::Lite::WithAPIv1_1;
use YAML::Tiny;
use Encode;
use FindBin;

# 現在のパスから見て設定ファイルを読み込み
my $config = (YAML::Tiny->read($FindBin::Bin . '/config.yml'))->[0];
# OAuth認証
my $twitter = Net::Twitter::Lite::WithAPIv1_1->new(
        traits => ['API::REST', 'OAuth'],
        consumer_key => $config->{'consumer_key'},
        consumer_secret => $config->{'consumer_secret'}
);
$twitter->access_token($config->{'access_token'});
$twitter->access_token_secret($config->{'access_token_secret'});

# 認証失敗時の処理
die('Auth failed:'.$config->{'username'}) unless ( $twitter->authorized ) ;

# ユーザー名を含むユーザー情報を取得
my $own_id = $twitter->verify_credentials->{id};

my $nextc = -1; # paging default.
my @following_id_list; # outgo

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
        # パラメータcursorは前回取得したフォローイングまでの番号が入っている
        my $following_list = $twitter->friends_ids({ id=>$own_id, cursor => $nextc });
        $nextc = $following_list->{next_cursor};
        # 配列からフォローイングのidを取得
        foreach my $id (@{ $following_list->{ids} }){
                push(@following_id_list, $id); # 後で比較するためにフォローイングを配列に保管
        }
}while($nextc!=0);
# 文字昇順でソート
@following_id_list = sort @following_id_list;

$nextc = -1;
my @followers_id_list; # income

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
        # パラメータcursorは前回取得したフォロワーまでの番号が入っている
        my $followers_list = $twitter->followers_ids({ id=>$own_id, cursor => $nextc });
        $nextc = $followers_list->{next_cursor};
        # 配列からフォロワーのidを取得
        foreach my $id (@{ $followers_list->{ids} }){
                push(@followers_id_list, $id); # 後で比較するためにフォロワーを配列に保管
        }
}while($nextc!=0);
# 文字昇順でソート
@followers_id_list = sort @followers_id_list;

# 差分を取得(フォローイング)
my $diff_following = Array::Diff->diff(\@following_id_list, \@followers_id_list);

# 差分を取得(フォロワー)
my $diff_followers = Array::Diff->diff(\@followers_id_list, \@following_id_list);

# リムった人をリム返し
foreach my $delid_following (@{ $diff_following->{deleted} }){
        eval{$twitter->destroy_friend({user_id => $delid_following})};
        # プライベートだとエラーになる人がいるので確認用
        print $delid_following . "\n" if($@);
}

# フォローした人をフォロー返し
foreach my $delid_followers (@{ $diff_followers->{deleted} }){
        eval{$twitter->create_friend({user_id => $delid_followers})};
        # プライベートだとエラーになる人がいるので確認用
        print $delid_followers . "\n" if($@);
}
シーザー暗号 ROT13 Perl 復号
9月 27, 2013 — 2:23

ありきたりですがPerlで書いてみました

#!/usr/bin/perl
print sub{$_[0]=~tr/A-Za-z/ZA-Yza-y/
for(1..$_[1]);$_[0]}->($s=<>,$k=<>);

文字列 + 改行 + ずらす回数 + 改行 で実行できます

結構短く書けるものですね

Twitter フォロワー同期(フォロー専用)Bot Perl 新API対応
7月 25, 2013 — 18:13

今更感がありますが以前書いたTwitter フォロワー同期(フォロー専用)Bot Perl 作成編についてTwitter APIの仕様変更により使えなくなっていたため修正したものを公開しておきます。

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

# モジュール使用宣言
use Array::Diff;
use Net::Twitter::Lite::WithAPIv1_1;
use YAML::Tiny;
use Encode;
use FindBin;

# 現在のパスから見て設定ファイルを読み込み
my $config = (YAML::Tiny->read($FindBin::Bin . '/config.yml'))->[0];
# OAuth認証
my $twitter = Net::Twitter::Lite::WithAPIv1_1->new(
        traits => ['API::REST', 'OAuth'],
        consumer_key => $config->{'consumer_key'},
        consumer_secret => $config->{'consumer_secret'}
);
$twitter->access_token($config->{'access_token'});
$twitter->access_token_secret($config->{'access_token_secret'});

# 認証失敗時の処理
die('Auth failed:'.$config->{'username'}) unless ( $twitter->authorized ) ;

# ユーザー名を含むユーザー情報を取得
my $cr = $twitter->verify_credentials;
my $own_id = $cr->{id};

my $nextc = -1; # paging default.
my @following_id_list; # outgo

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
        # パラメータcursorは前回取得したフォローイングまでの番号が入っている
        my $following_list = $twitter->friends_ids({ id=>$own_id, cursor => $nextc });
        $nextc = $following_list->{next_cursor};
        # 配列からフォローイングのidを取得
        foreach my $id (@{ $following_list->{ids} }){
                push(@following_id_list, $id); # 後で比較するためにフォローイングを配列に保管
        }
}while($nextc!=0);
# 文字昇順でソート
@following_id_list = sort @following_id_list;

$nextc = -1;
my @followers_id_list; # income

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
        # パラメータcursorは前回取得したフォロワーまでの番号が入っている
        my $followers_list = $twitter->followers_ids({ id=>$own_id, cursor => $nextc });
        $nextc = $followers_list->{next_cursor};
        # 配列からフォロワーのidを取得
        foreach my $id (@{ $followers_list->{ids} }){
                push(@followers_id_list, $id); # 後で比較するためにフォロワーを配列に保管
        }
}while($nextc!=0);
# 文字昇順でソート
@followers_id_list = sort @followers_id_list;

# 差分を取得(フォローイング)
my $diff_following = Array::Diff->diff(\@following_id_list, \@followers_id_list);

# 差分を取得(フォロワー)
my $diff_followers = Array::Diff->diff(\@followers_id_list, \@following_id_list);

# リムった人をリム返し
foreach my $delid_following (@{ $diff_following->{deleted} }){
        $twitter->destroy_friend({user_id => $delid_following});
}

# フォローした人をフォロー返し
foreach my $delid_followers (@{ $diff_followers->{deleted} }){
        $twitter->create_friend({user_id => $delid_followers});
}
Perl LWP::UserAgentを使ったHTTPS接続
5月 7, 2013 — 14:47

PerlでLWP::UserAgentを使い、HTTPSサイトへ接続を行いコンテンツを取得してくるプログラムを書く必要が出てきて、色々調べて書いたのですが情報が錯綜していたりで結構ハマったのでソースコードを載せておきます。
今回わけあったりでコンストラクタ側でProxyの情報を保持していなかったりしますが、そこはお好きに改変してお使いください。

#########################################################
#
# LWP::UserAgentを使ったHTTPS接続
#
#########################################################
use utf8;
use strict;
use warnings;

{
    package ProxyWebGet;

    use LWP::UserAgent;

    # コンストラクタ
    sub new {
        my ($class, @args) = @_;
        my %args = ref $args[0] eq 'HASH' ? %{$args[0]} : @args;
        my $self = {%args};

        # オプション項目
        $self->{ac_timeout} ||= 10;    # プロキシ接続時のタイムアウト(秒)

        return bless $self , $class;
    }

    # ホストとポート番号に対してProxy接続を行う
    # 引数にホストとポート番号と接続先URLを指定する
    sub proxy_connect {
        my $self = shift;
        my $proxy_host = shift; # ホストを受け取る
        my $proxy_port = shift; # ポート番号を受け取る
        my $target_url = shift; # 接続先URL

        # ホストとポート番号をLWP::UserAgentで利用できる形式に整形する
        my $http_proxy = 'http://' . $proxy_host . ':' . $proxy_port;

        $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = 'Net::SSL';
        $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}    = 0;
        $ENV{HTTPS_PROXY}   = $http_proxy;
        $ENV{HTTPS_VERSION} = 3;

        # LWP::UserAgentのインスタンスの生成
        my $ua = LWP::UserAgent->new(
            timeout => $self->{ac_timeout} # オプションにタイムアウト時間を指定
        );

        # ヘッダーにUTF-8を含む場合エラーが出るため解析しない
        $ua->parse_head(0);

        # 整形したProxyを指定
        $ua->proxy(['http'], $http_proxy);

        # 指定されたURLへ接続する
        # FTP等のプロトコルに接続を行った場合
        # コネクションが維持されるため強制的に破棄する
        my $res = "";
        eval{
            local $SIG{ALRM} = sub{die "timeout"};
            alarm($self->{ac_timeout});   # タイマー設定
            $res = $ua->get($target_url); # URLへ接続しコンテンツを取得
            alarm(0);                     # タイマー解除
        };

        # ステータスコードが正常である場合、コンテンツを返す
        my $result = $res->is_success() ? $res->content() : "";

        return $result;
    }
}

{
    # sub main
    my $pwg = ProxyWebGet->new();

    print $pwg->proxy_connect(
              '000.000.000.000',
              '0000',
              'https://ja.wikipedia.org/wiki/'
          );
}
Perl IPアドレスを10進数の整数型に変換し戻す
4月 17, 2013 — 12:49

データベースにIPアドレスを格納する時は整数型にしたほうがブロックで検索出来たりと後々取り扱いが楽だったりするので変換する変換方法を書いてみる

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

my $addr_i = &addr_s_to_i("192.168.1.1");
my $addr_s = &addr_i_to_s($addr_i);
print "INTEGER:" . $addr_i . "\n";
print "STRING :" . $addr_s . "\n";

# IPアドレスを文字列型から整数型に変換
sub addr_s_to_i {
    my $addr = shift;

    # "."ごとに8bitずつ区切りそれを2進数に変換し配列に入れる
    my @addrs;
    foreach my $addr_split (split('\.', $addr)){
        push(@addrs, sprintf("%08b", $addr_split));
    }

    # 区切った2進数を連結する
    my $bin = join('', @addrs);
    # 2進数を10進数に変換
    my $result = oct('0b' . $bin);

    return $result;
}

# IPアドレスを整数型から文字列型に変換
sub addr_i_to_s {
    my $addr = shift;

    # 10進数を32bitの2進数に変換
    my $bin = sprintf("%032b", $addr);

    # 2進数を8bitごとに区切り10進数に変換し配列に入れる
    my @addrs;
    foreach my $addr_split ($bin =~ m/.{8}/g){
        push(@addrs, oct('0b' . $addr_split));
    }

    # "."ごとに区切り連結する
    my $result = join('.', @addrs);

    return $result;
}

実行結果
INTEGER:3232235777
STRING :192.168.1.1

Perlに変数の型は無いが変数の型を意識しないプログラムは書いてはいけない
4月 15, 2013 — 11:32

Perlには変数の型は無いですが最近変数の容量を見なければならない機会があり調べていたところPerlの変数には型は存在しないが型を意識したプログラムを書かなければならない事が分かったためメモしておく。

#!/sur/bin/perl
use utf8;
use strict;
use warnings;

use Devel::Size qw(size total_size);

my $DATA = 1000;
my $INIT = "";

# 直接操作した場合
{
    print "[variable]\n";

    my $data = $DATA;
    my $init = $INIT;

    my $res = $init;
    for(my $i = 0; $i < $data; $i++){
        $res .= "*";
    }

    print "Before initialization :". size($res) . "\n";

    $res = $INIT;

    print "After initialization  :". size($res) . "\n";
}

# 関数の場合
{
    print "[function]\n";

    my $res = &routine($DATA, $INIT);

    print "Before initialization :". size($res) . "\n";

    $res = &routine(0, $INIT);

    print "After initialization  :". size($res) . "\n";

    sub routine {
        my $data = shift;
        my $init = shift;

        my $result = $init;
        if($data){
            for(my $i = 0; $i < $data; $i++){
                $result .= "*";
            }
        }
        return $result;
    }
}

# メソッドの場合
{
    print "[ method ]\n";

    my $mt = MemTester->new();

    my $res = $mt->routine($DATA, $INIT);

    print "Before initialization :". size($res) . "\n";

    $res = $mt->routine(0, $INIT);

    print "After initialization  :". size($res) . "\n";


    package MemTester;

    sub new {
        my ($class, @args) = @_;
        my %args = ref $args[0] eq 'HASH' ? %{$args[0]} : @args;
        my $self = {%args};

        return bless $self , $class;
    }

    sub routine {
        my $self = shift;
        my $data = shift;
        my $init = shift;

        my $result = $init;
        if($data){
            for(my $i = 0; $i < $data; $i++){
                $result .= "*";
            }
        }
        return $result;
    }
}

最初の値を整数(“$INIT = 0”)で初期化した場合の実行結果
[variable]
Before initialization :1056
After initialization :1056
[function]
Before initialization :1056
After initialization :1056
[ method ]
Before initialization :1056
After initialization :1056

最初の値を文字(“$INIT = ””)で初期化した場合の実行結果
[variable]
Before initialization :1048
After initialization :1048
[function]
Before initialization :1048
After initialization :48
[ method ]
Before initialization :1048
After initialization :48

このように、文字列と数値を混同して使用した変数は多くメモリを消費することが分かる。
さらに、返り値としてデータを受け取った場合、その分受け取った変数もメモリを無駄に使用するためさらに効率は低下する。

Webページを取得するなど文字列を大量に格納し返すようなプログラムを書く場合は取得に失敗した場合は0を返すのではなく””を返すべきである。

数字(例:0)より文字列(例:”0″)の方がメモリを多く使用することは当然のことであるが、変に気取って返り値を混同するような関数やメソッドは書いてはならない事が分かった。

Perl cpanでインストールしたIP::Countryのデータベースを更新する 更新スクリプトの作成 CentOS
4月 10, 2013 — 13:35

IP::Countryには”whois_filenames”と呼ばれるDB更新用のスクリプトが同封されているがインストールされないためcpanでインストール後は非常に困る。その上、更新用スクリプトを単純にコピーして実行しても正しく動作しないため、今回アップデート用のスクリプトを改良しインストール後でも使用出来るようにしておく。

なお、更新用スクリプトはメモリを非常に使うためマシン側では物理的に4GB以上のメモリを搭載している必要があるかもしれない。

“dbmScripts”ディレクトリの存在確認
# ls ~/.cpan/build/IP-Country-2.27/dbmScripts/

“IP::Country”のインストール場所の確認
# ls /usr/lib/perl5/site_perl/5.8.8/IP/

“dbmScripts”ディレクトリのコピー
# cp -R ~/.cpan/build/IP-Country-2.27/dbmScripts/ /usr/lib/perl5/site_perl/5.8.8/IP/

“dbmScripts”ディレクトリへ移動
# cd /usr/lib/perl5/site_perl/5.8.8/IP/dbmScripts/

アップデート用スクリプトをbashにて作成
# vi whois_filenames

#!/bin/bash

wget ftp://ftp.ripe.net/ripe/dbase/split/ripe.db.inetnum.gz && gunzip ripe.db.inetnum.gz
wget ftp://ftp.ripe.net/pub/stats/afrinic/delegated-afrinic-extended-latest
wget ftp://ftp.ripe.net/pub/stats/apnic/delegated-apnic-extended-latest
wget ftp://ftp.ripe.net/pub/stats/arin/delegated-arin-extended-latest
wget ftp://ftp.ripe.net/pub/stats/lacnic/delegated-lacnic-extended-latest

perl ipcc_loader.pl && perl ipcc_maker.pl && perl ipauth_loader.pl && perl ipauth_maker.pl

rm -f *extended-latest* ripe.db.inetnum* sorted_*.txt*

読み込むファイル名が異なるため修正

# vi ipauth_loader.pl

69行目付近

read_reg('delegated-afrinic-extended-latest'); # 修正
read_reg('delegated-lacnic-extended-latest');  # 修正
read_reg('delegated-apnic-extended-latest');   # 修正
read_ripe();
read_reg('delegated-arin-extended-latest');    # 修正

join_neighbours();
punch_holes();
optimize();
output();

# vi ipcc_loader.pl

69行目付近

read_reg('delegated-afrinic-extended-latest'); # 修正
read_reg('delegated-lacnic-extended-latest');  # 修正
read_reg('delegated-apnic-extended-latest');   # 修正
read_ripe();
read_reg('delegated-arin-extended-latest');    # 修正

join_neighbours();
punch_holes();
optimize();
output();

DBのパスが違うため”ipauth_maker.pl”と”ipcc_maker.pl”のパスを修正

# vi ipauth_maker.pl

32行目付近

print "Saving ultralite IP registry to disk\n";
my $ip = new IO::File "> ../Authority/ipauth.gif"; # 修正
if (defined $ip) {
    binmode $ip;
    print $ip pack("N",time()); # returned by $obj->db_time()
    $tree->printTree($ip);
    $ip->close();
} else {
    die "couldn't write IP registry:$!\n";
}

44 行目付近

print "Saving ultralite country database to disk\n";

open (CC, "> ../Authority/auth.gif") # 修正
    or die ("couldn't create authority database: $!");
binmode CC;
foreach my $country (sort $tree->get_countries()){
    print CC substr(pack('N',$tree->get_cc_as_num($country)),3,1).$country;
}

# vi ipcc_maker.pl

33行目付近

print "Saving ultralite IP registry to disk\n";
my $ip = new IO::File "> ../Country/Fast/ip.gif"; # 修正
if (defined $ip) {
    binmode $ip;
    print $ip pack("N",time()); # returned by $obj->db_time()
    $tree->printTree($ip);
    $ip->close();
} else {
    die "couldn't write IP registry:$!\n";
}

45行目付近

print "Saving ultralite country database to disk\n";

open (CC, "> ../Country/Fast/cc.gif") # 修正
    or die ("couldn't create country database: $!");
binmode CC;
foreach my $country (sort $tree->get_countries()){
    print CC substr(pack('N',$tree->get_cc_as_num($country)),3,1).$country;
}

作成した”db_update”に実行権を与える
# chmod 755 whois_filenames

アップデート実行
# sh whois_filenames

__追記__
2016/06/16 delegated-arin-latestなどがextended-latest形式に変更となっていたため記事の一部を更新しました

Perl Nmap::Scanner インストール
2月 18, 2013 — 0:58

Perlでnmapを利用したプログラムを書きたくなったので調度良さそうなライブラリを探していたところNmap::Scannerというものを見つけた。

# cpan install Nmap::Scanner
と実行したところエラーが発生した。原因はClass::Generateがインストールできないかららしい。

面倒なことにClass::Generateの現行バージョンはPerl 5.10以上でなければならないらしい。
そこでバージョンを探してみた結果、Class::Generate 1.09があったためこちらを指定してインストールした。

cpan> install S/SW/SWARTIK/Class-Generate-1.09.tar.gz

その後、Nmap::Scannerをもう一度インストールしてみたところ問題なくインストールできた。

まともなサンプルコードも少ないので載せておく。

#!/usr/bin/perl
use Nmap::Scanner;
my $scan = Nmap::Scanner->new();
$scan->add_target('localhost');

my $results = $scan->scan();

my $hosts = $results->get_host_list();

while (my $host = $hosts->get_next()) {
    my $hostname  = $host->hostname();
    my $addresses = join(',', map {$_->addr()} $host->addresses());
    print "Check Host " . $hostname . "\n";
    print "Check Adrr " . $addresses . "\n";

    my $ports = $host->get_port_list();

    while (my $port = $ports->get_next()) {
        my $service = $port->service();
        print join(' ',
            'Port',
            $port->protocol() . '/' . $port->portid(),
            'Service',
            $service->name(),
            'is in state',
            $port->state(),
            "\n"
        );
    }

}