バージョン選択

フォーラム

メニュー

オンライン状況

53 人のユーザが現在オンラインです。 (31 人のユーザが フォーラム を参照しています。)
登録ユーザ: 3
ゲスト: 50
hyderabadh fastshot 468 もっと...

サイト内検索

 > 管理機能 > 管理者フォーム自動操作で特定ユーザにポイントを加算するPerlスクリプト

管理機能

新規スレッドを追加する

フラット表示 前のトピック | 次のトピック
投稿者 スレッド
ono
投稿日時: 2006/12/19 11:42
対応状況: −−−
新米
登録日: 2006/12/5
居住地:
投稿: 3
管理者フォーム自動操作で特定ユーザにポイントを加算するPerlスクリプト
機能要望 > その他 > ポイント付加リストファイルをバッチ処理でインポートできる仕組み
http://xoops.ec-cube.net/modules/newbb/viewtopic.php?topic_id=254&forum=3

で出した要望について、とりあえず自分で作ってみたので、投稿します。

管理者用フォームを直接操作しますので、EC-Cube側のパッケージのhtml記述の変更によって動かなくなる可能性があります。

質問 > その他 > 管理者ログインフォームのフォーム名について
http://xoops.ec-cube.net/modules/newbb/viewtopic.php?topic_id=265&forum=2

また、ポイントを扱うものですので、使用に当たっては注意してください。当方はこれを使用したことに関する損害は保証できません。


#!/usr/bin/perl
 
# pointrobot.pl
# タブ区切りテキスト(e-mail \tpoint \n)を入力し、
# EC-Cube の 管理用ページ(admin/)の html にアク
# セスし、顧客毎にポイントを加算します。
# 
# 履歴
# 0.01 2006/12/19 試作品 EC-Cube 1.02beta でテスト。
 
use strict;
use warnings;
use WWW::Mechanize;
use utf8;
use Encode;
use Data::Dumper;
binmode STDOUT, ":encoding(cp932)";
  # 標準出力:CP932(Windows ActivePerl環境)
binmode STDERR, ":encoding(cp932)";
  # 標準エラー出力:CP932(Windows ActivePerl環境)
 
# -------------------------------------
# 初期設定
# -------------------------------------
 
# EC-Cube Admin root
 
my $adminroot_url
  = 'https://localhost/eccube/admin';
 
# ID/Password, 顧客mail/ポイント
 
my $username = 'hogehoge';
my $password = 'fugafuga';
 
my $warn = 0;
 
# #####################################
# メインルーチン 
# #####################################
 
# -------------------------------------
# テキストファイルから、リストに取り込み
# -------------------------------------
 
my $length = @ARGV;
usage() if $length eq 0;
 
my $logfile;
if (@ARGV && $ARGV[0] eq "-l") {
  shift;
  $logfile = shift;
}
 
write_log('プログラムを開始しました。');
 
my $list;
while(<>) {
  tr/\x0d\x0a//d;
  (my $email, my $point) = split("\t", $_);
  $list->{$email} = $point;
}
 
# -------------------------------------
# ポイントリストに従って、
# EC-Cube にポイントを加算
# -------------------------------------
 
point($adminroot_url,$username,
                  $password, $list);
 
# -------------------------------------
# 終わり
# -------------------------------------
 
if ($warn) {
  write_log('注意…何点か警告があります。');
  exit 0;
}
write_log('プログラムは正常に終了しました。');
exit 1;
 
# #####################################
# サブルーチン
# #####################################
 
 
#-------------------------------------
# ハッシュリストに従いポイントを登録
#-------------------------------------
 
sub point {
  
  my $adminroot_url = shift;
  my $username      = shift;
  my $password      = shift;
  my $list          = shift;
 
  # WWW:Mechanize オブジェクト生成
  
  my $mech    = WWW::Mechanize->new();
  
  # ログイン 
   
  my $response = point_login($mech, $username, $password);
 
  # ポイントセット 
  
  foreach my $email (keys %$list) {
    $response = point_set ($mech, $email, $list -> {$email});
    if ($response) {
      write_log($response);
      warn $response;
      $warn ++;
    }
  }
   
  # 終わり
  
  return 1;
}
 
# #####################################
# WWW::Mechanize サブルーチン
# #####################################
 
#-------------------------------------
# ログイン
#-------------------------------------
 
sub point_login { 
  
  # 引数
  
  my $mech     = shift;
  my $username = shift;
  my $password = shift;
   
  # $mechurl に遷移
 
  my $mechurl = "$adminroot_url/index.php";
  $mech -> get($mechurl);
  unless($mech->success) {
    write_log("$mechurl :". $mech->response->status_line);
    die       "$mechurl :". $mech->response->status_line;
  }
  
  # ログインフォーム入力
  
  $mech -> submit_form (
    form_name =>'form1',
    fields    => {
      login_id => $username,
      password => $password,
    },
  );
  if ($mech->uri eq "$adminroot_url/login.php" ) {
    write_log("login 失敗!: ");
    die       "login 失敗!: ";
  }
  return;
}
 
#-------------------------------------
# ポイントセット
#-------------------------------------
 
sub point_set {
  
  # 引数
  
  my $mech  = shift;
  my $email = shift;
  my $point = shift;
  
  # ログイン済み
  # カスタマーインデックスに移動(URL直接指定)
  
  my $mechurl
    = "$adminroot_url/customer/index.php";
  $mech->get($mechurl);
  unless($mech->success) {
    write_log("$mechurl :", $mech->response->status_line);
    die       "$mechurl :", $mech->response->status_line;
  }
  
  # e-mailで検索
  
  $mech -> submit_form (
    form_name=>'form_search',
    fields => {
      email => $email,
      
    },
  );
  
  # 検索済み
  # 該当者がいるかどうか
  # いなければエラー 'e-mail not found'
  
  my $html = $mech->content();
  
  my $customer_id;
  @{$customer_id} = ();
  while ($html
    =~m|onclick="return fnEdit\('(\d+?)'\);|sgo) {
    push @{$customer_id}, $1;
  }
  # print Dumper($customer_id);
  my $length = @{$customer_id};
  if ($length eq 0) {
    return 'e-mail not found';
  }
  
  
  # [編集]リンクはJavaScriptでPOSTのActionを
  # 変えているので、それを模す。
  # 要 update_html(WWW::Machanize 1.00以上必要)
   
  $html =~ s|<form name="form1" id="form1" method="post" action="/eccube/html/admin/customer/index.php">|<form name="form1" id="form1" method="post" action="./edit.php">|;
  
  $mech -> update_html( $html );
    # HTML置き換え(JavaScript相当)
  
  $mech -> submit_form (
    form_name=>'form1',
    fields => {
      mode   => 'edit_search',
      edit_customer_id
             => @{ $customer_id }[0],
    },
  );
  
  
  # 顧客を選択した画面。
  # pointを取得し$pointを加算
  
  $mech -> form_name('form1');
  my $point_now = $mech->field( 'point' );
  $point_now = 0 if $point_now eq '';
  $point_now += $point;
  if ( $point_now < 0 ) {
    return $email.' ポイントが0より少なくなるのでやめました。';
  }
  $mech -> set_fields (
      point => $point_now,
    );
  $mech -> submit();
  
  
  # 確認画面。
  # そのまま submit する
  
  $mech -> form_name('form1');
  $mech -> submit();
  return;
}
 
sub usage {
  print <<"ENDEND";
usage: \$0 [-l logfile] [filenames] ...
 
ポイントリストファイルの内容に従い、該当
e-mailアドレスを持つアカウントのユーザの
ポイントを加算(減算)します。
ENDEND
  exit;
}
 
sub write_log {
  my $message = shift;
  if( $logfile ) {
    open (my $fh, '+>>', $logfile )
      or die "ファイルが開けません";
    my $time = timestamp();
    print $fh encode('cp932', "$time  $message\n");
  }
}
 
sub timestamp {
  (my $sec, my $min, my $hour,
    my $mday, my $mon, my $year) = localtime(time);
  return sprintf "%02d/%02d/%02d %02d:%02d:%02d",
    $year+1900, $mon+1, $mday, $hour, $min, $sec; 
}
__END__
フラット表示 前のトピック | 次のトピック


題名 投稿者 日時
 » 管理者フォーム自動操作で特定ユーザにポイントを加算するPerlスクリプト ono 2006/12/19 11:42

 



ログイン


EC-CUBEペイメント

公式ストアEC-CUBE4系デザインテンプレート続々リリース中

統計情報

総メンバー数は65,898名です
総投稿数は98,045件です

投稿数ランキング

1
seasoft
7332
2
AMUAMU
2712
3
468
2597
4
nanasess
2101
5
umebius
1717
6
yuh
1612
7
red
1422
8
h_tanaka
1038
9
fukap
907
10
tsuji
863
11
shutta
835
12
tao_s
792
13 ramrun 789
14 karin 657
15 sumida 641
16
homan
633
17 DELIGHT 571
18
patapata
502
19
flealog
485
20 tonton 437


ネットショップの壺

EC-CUBEインテグレートパートナー

Copyright© EC-CUBE CO.,LTD. All Rights Reserved.