Dreamのお好み情報箱

#!/usr/bin/perl -w
use strict;
use LWP 5.64;
use HTTP::Cookies;
use Encode;
use encoding 'shiftjis';   # 使用しているプラットフォームにあわせてください。
binmode(STDERR, ':raw :encoding(shiftjis)');  # 同上

my $url = 'https://www.naiiv.gr.jp/user_entrance/memberlink';

my $cookie_file = "./cookie.txt";

my $id = 'naiiv_id'; #ここにナイーブネットのIDを記述

my $pass = 'naiiv_password'; #ここにナイーブネットのパスワードを記述

my $browser = LWP::UserAgent->new;

my $cookie_jar = HTTP::Cookies->new(file => $cookie_file, autosave => 1, ignore_discard => 1);

$browser->cookie_jar($cookie_jar);

$browser->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)'); #IEをエミュレート

my $response = $browser->post( $url,

    [ 'USER_ID' => $id,

      'USER_PASS' => $pass,

    ]

);

die "$url エラー： ", $response->status_line unless $response->is_success;

die "$url のコンテンツタイプが不正です。-- ", $response->content_type

   unless $response->content_type eq 'text/html';

# 以降は、コンテンツの処理

# $contentを読み込む

my $content = decode('shiftjis', $response->content);   # コード変換

print $content; #取得したコンテンツを表示

sub URI::query_form {

    my $self = shift;

    my $old = $self->query;

    if (@_) {

        # Try to set query string

        my @query;

        while (my($key,$vals) = splice(@_, 0, 2)) {

            $key = '' unless defined $key;

            $key =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g;

            $key =~ s/ /+/g;

            $vals = [ref($vals) ? @$vals : $vals];

            for my $val (@$vals) {

                $val = '' unless defined $val;

#################### ここから日本語化パッチ部分 ####################

                my @work = unpack('C*', $val);

                $val = '';

                foreach my $c (@work) {

                    if ((($c >= 0x30) && ($c <= 0x39)) ||    # 数値はそのまま

                        (($c >= 0x41) && ($c <= 0x5A)) ||    # アルファベット（大文字）もそのまま

                        (($c >= 0x61) && ($c <= 0x7A))) {    # アルファベット（小文字）もそのまま

                        $val .= chr($c);

                    } elsif ($c == 0x20) {                   # 空白は'+'に

                        $val .= '+';

                    } else {                                 # それ以外は%XX形式に変換する。

                        $val .= sprintf("%%%02X", $c);

                    }

                }

#################### 日本語化パッチ部分ここまで ####################

# この行は削除  $val =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g;

# この行は削除  $val =~ s/ /+/g;

                push(@query, "$key=$val");

            }

        }

        $self->query(join('&', @query));

    }

    return if !defined($old) || !length($old) || !defined(wantarray);

    return unless $old =~ /=/; # not a form

    map { s/\+/ /g; uri_unescape($_) }

         map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/&/, $old);

}