| 재배 이력 |
|---|
};
# my $history = qq{
#
#
#
# };
foreach (reverse(@lines)) {
my ($time, $comm, $color) = split(/\t/, $_);
my $time_str = get_time_str($time);
if(!$color) {$color = "blue";}
$history .= "
| $time_str: |
$comm |
";
}
$history .= qq{
| |
};
return $history;
}
###################################################
# input:()
# retrun:
#comment:
#plantID,이름, 심은 초, 성장한 초,,성장 단계, 빛과 온도, 초, 체크한 초,
#수분, 초, 체크한 초, 영양, 초, 체크한 초, 장소, 유전자 1,유전자 2
###################################################
sub change_step_time
{
my ($rp, $rproc, $time, $kind) = @_;
my $add = $kind * 3 + 6;
my ($sstep, $stime, $cstime) = (@$rp)[$add, 1 + $add, 2 + $add];
my $term_hr = $RDATA->{term} * 6;
my $rstep = $RDATA->{term_rate};
my $pass_time = $time - $cstime;
while($pass_time >= $term_hr) {
my $next_flg = 0;
while($pass_time >= $term_hr) {
my $pass_term = ($cstime - $stime) / $term_hr;
my $rand_rate = (defined($rstep->[$pass_term]))? $rstep->[$pass_term]:
($pass_term < 5)? (0, 3 / 10, 1 / 7, 1 / 6, 2 / 5)[$pass_term]: 1;
if(rand() < $rand_rate) {$next_flg = 1;}
$cstime += $term_hr;
$pass_time -= $term_hr;
if($next_flg) {
$stime = $cstime;
if($sstep > 0 && ($rp->[26] & 2) == 0) {$sstep--;}
push(@{$rproc->[$kind]}, [$sstep, $cstime]);
last;
}
push(@{$rproc->[$kind]}, [$sstep, $cstime]);
}
}
($rp->[$add], $rp->[1 + $add], $rp->[2 + $add])
= ($sstep, $stime, $cstime);
return 1;
}
###################################################
# input:()
# retrun:
#comment:
# $place = 0:외 매치,1:밖안 매치,2:안매치,3:안안 매치
#plantID,이름, 심은 초, null,성장 레벨, 성장 단계, 빛과 온도, 초, 체크한 초,
#수분, 초, 체크한 초, 영양, 초, 체크한 초, 장소, 유전자 1,유전자 2
#
#$place = 0:외 매치,1:밖안 매치,2:안매치,3:안안 매치
###################################################
sub change_step_time_for_sun
{
my ($rp, $rproc, $time) = @_;
my ($sstep, $stime, $cstime, $place) = (@$rp)[6, 7, 8, 15];
my $term_hr = $RDATA->{term} * 6;
my $rstep = $RDATA->{term_rate};
my $change = ($RDATA->{change_rate})? 1 / $RDATA->{change_rate}: 1 / 18;
my $pass_time = $time - $cstime;
while($pass_time >= $term_hr) {
my $next_flg = 0;
while($pass_time >= $term_hr) {
if($place % 2 == 0 && rand() < $change) {
$place ++;
}
my $pass_term = ($cstime - $stime) / $term_hr;
my $rand_rate = (defined($rstep->[$pass_term]))? $rstep->[$pass_term]:
($pass_term < 5)? (0, 3 / 10, 1 / 7, 1 / 6, 2 / 5)[$pass_term]: 1;
if(rand() < $rand_rate) {$next_flg = 1;}
$cstime += $term_hr;
$pass_time -= $term_hr;
if($next_flg) {
$stime = $cstime;
if($place % 2 == 1 && $sstep > 0 && ($rp->[26] & 4) == 0) {$sstep--;}
if($place % 2 == 0 && $sstep < 9) {$sstep++;}
push(@{$rproc->[0]}, [$sstep, $cstime]);
last;
}
push(@{$rproc->[0]}, [$sstep, $cstime]);
}
}
($rp->[6], $rp->[7], $rp->[8], $rp->[15])
= ($sstep, $stime, $cstime, $place);
return 1;
}
###################################################
# input:()
# retrun:
#comment:$rplant의 내용이 변경됩니다
#plantID,이름, 심은 초, 성장한 초, 체크한 초, 성장 단계, 빛과 온도, 초, 체크한 초,
#수분, 초, 체크한 초, 영양, 초, 체크한 초, 장소, 유전자 1,유전자 2
###################################################
sub change_plant_data
{
my ($rdata, $uid) = @_;
my $alert;
my ($pid, $option, $name) = split(/!/, $PARAM->{OPT});
my $num = $PARAM->{NUM} || 1;
my $step = $rdata->[5];
if($option eq "w" && 0 <= $step && $step <= 4) {
if($rdata->[9] >= 9) {$alert = "더 이상 물을 줄 수 없습니다.";}
else {
$rdata->[9] += $num;
$rdata->[9] = 9 if($rdata->[9] > 9);
}
} elsif($option eq "p") {
$rdata->[15] = 3 - $rdata->[15];
} elsif($option eq "pi") {
$rdata->[15] = 0 if($rdata->[15] == 3);
$rdata->[15] = 1 if($rdata->[15] == 2);
} elsif($option eq "po") {
$rdata->[15] = 3 if($rdata->[15] == 0);
$rdata->[15] = 2 if($rdata->[15] == 1);
} elsif($option eq "n" && 0 <= $step && $step <= 5) {
my $old_name = $rdata->[1];
if($old_name eq $name) {
$alert = "같은 이름입니다.";
} elsif($name ne get_safe_htm($name)) {
$alert = "이름에 불가능한 문자가 포함되어 있습니다.";
} elsif(!$name) {
$alert = "이름이 입력되어 있지 않습니다.";
} else {
put_self_history($uid,
"「$old_name」을「$name」으로 개명하였습니다.");
$rdata->[1] = $name;
}
}
return $alert;
}
###################################################
# input:()
# retrun:
#comment:$rplant의 내용이 변경됩니다
#plantID,이름, 심은 초, 성장한 초, 체크한 초, 성장 단계, 빛과 온도, 초, 체크한 초,
#수분, 초, 체크한 초, 영양, 초, 체크한 초, 장소, 유전자 1,유전자 2
###################################################
sub change_seed_data
{
my ($rseed, $uid) = @_;
my $alert;
my ($pid, $option, $name) = split(/!/, $PARAM->{RENAME});
if(defined($rseed->{"$pid"}) && $option eq "n") {
my $old_name = $rseed->{"$pid"}->[2];
if($old_name eq $name) {
$alert = "같은 이름입니다.";
} elsif($name ne get_safe_htm($name)) {
$alert = "이름에 불가능한 문자가 포함되어 있습니다.";
} elsif(!$name) {
$alert = "이름이 입력되어 있지 않습니다.";
} else {
$alert = "종의 이름을 변경했습니다.";
put_self_history($uid,
"종의 이름:「$old_name」을「$name」으로 개명하였습니다.");
$rseed->{"$pid"}->[2] = $name;
}
}
return $alert;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_registration_start_htm
{
my $str;
my $rudata = get_all_udata();
if(@$rudata < $RDATA->{max_user}) {
my $uname_reged = get_uname_reged($rudata);
if(defined($uname_reged)) {
$str = get_start_htm($RDATA->{mlutireg_warn}, $uname_reged);
} else {
$str = get_usr_registration_htm();
}
} else {
$str = get_start_htm();
}
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_uname_reged
{
my ($rudata) = @_;
my ($uname_reged);
if($RDATA->{mlutireg_warn}) {
my $reg_ip = $ENV{'REMOTE_ADDR'};
foreach (@$rudata) {
if($reg_ip eq $_->[7]) {
$uname_reged = $_->[1];
last;
}
}
}
return $uname_reged;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_usr_registration_htm
{
my $err_str = shift;
my $home_url = ($PARAM->{HP} =~ /^http:\/\//)? $PARAM->{HP}: "http://";
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= get_regist_jscript();
$str .= qq{
유저 등록 화면
};
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_reg_tr_htm
{
my ($name_htm, $pwd, $sex, $livein, $home_url, $mail, $opn) = @_;
$home_url = ($home_url =~ /^http:\/\//)? $home_url: "http://";
$opn = ($opn)? "checked": "";
my $str = qq{
|
|
*닉네임： |
$name_htm |
|
*패스워드：
|
|
*패스워드(재)：
|
|
|
|
아래의 데이터를 공개할 경우 체크하여 주십시오.
|
|
거주지： |
|
성별： |
|
|
홈페이지：
|
|
|
메일어드레스：
|
|
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_usr_registration_check_htm
{
my $name = get_safe_htm($PARAM->{NAM});
my $pwd = get_safe_htm($PARAM->{PWD});
my $ken = get_safe_htm($PARAM->{KEN});
my $sex = get_safe_htm($PARAM->{SEX});
my $hp = get_safe_htm($PARAM->{HP});
my $mail = get_safe_htm($PARAM->{MAIL});
my $opns = ($PARAM->{OPN})? "공개": "비공개";
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
유저등록 체크화면
};
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_usr_registration_change_htm
{
my $str;
my $uid = $PARAM->{UID};
my $rallu = get_all_udata_hash();
my $ru = $rallu->{"$uid"};
if($PARAM->{OPT} eq "delete") {
delete($rallu->{"$uid"});
put_all_udata($rallu);
delete_regist_user($uid);
$str = get_start_htm("유저 정보를 삭제했습니다.");
} elsif(!$PARAM->{NAM}) {
$str = get_usr_registration_change_input_htm($uid, $ru);
} elsif(my $err_htm = get_regist_err_html({name_nocheck => 1})) {
$str = get_usr_registration_change_input_htm($uid, $ru, $err_htm);
} else {
my $opn = ($PARAM->{OPN})? 1: 0;
my $pwd = get_safe_htm($PARAM->{PWD});
$pwd = get_epass($pwd) if($RDATA->{cipher});
@$ru[2, 3, 4, 5, 6, 9] = (
$pwd, get_safe_htm($PARAM->{HP}),
get_safe_htm($PARAM->{MAIL}), get_safe_htm($PARAM->{SEX}),
get_safe_htm($PARAM->{KEN}), $opn
);
put_all_udata($rallu);
$str = get_main_htm($uid, "유저등록정보를 갱신했습니다");
}
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_usr_registration_change_input_htm
{
my ($uid, $ru, $err_str) = @_;
my $pwd = $ru->[2] if(!$RDATA->{cipher});
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= get_regist_jscript();
$str .= qq{
유저등록정보 변경화면
};
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:MODE가 main의 경우만 Lock이 필요
###################################################
sub get_main_htm
{
my ($uid, $alert_str) = @_;
my $rudata = get_status_data($uid);
if($PARAM->{MODE} eq "main" && $PARAM->{OPT} eq "u" && $rudata->[1]->[8] == 1) {
exec_uranai($rudata, $uid); #rudata내 변경
put_status_data($uid, $rudata);
}
my $uname = get_uname($uid);
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= get_main_js();
$str .= get_hpb_js();
$str .= qq{
$uname의 믿을수 없는 식물.
};
$str .= get_flower_htm($uid, $rudata);
$str .= get_ustatus_htm($uid, $rudata, $alert_str, {property => 1});
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub exec_uranai
{
my ($rudata, $uid) = @_;
my $u_time = get_uranai_time();
if(int(($rudata->[0]->[9] + $JST) / 86400) < int(($u_time + $JST) / 86400)) {
my $hist_str;
my $ruranai = get_user_uranai($uid);
my ($frt_type, $order_str) = @$ruranai;
if($frt_type != 4) {
my $rplant = get_plant_data($uid);
my $rp = (values(%$rplant))[int(rand() * keys(%$rplant))];
my ($pname, $rcreature, $grow_level, $grow_step, $prom_flg)
= (@$rp)[1, 3, 4, 5, 26];
if(0 <= $grow_step && $grow_step <= 4) {
my $new_grow_level = $grow_level + (4, 2, 2, 1, 0, -1, -4)[$frt_type];
my $up_point = $RDATA->{next_grow}->[$grow_step]
+ get_grow_add($grow_step, $rcreature);
$up_point /= 2 if($prom_flg & 1); #小?可なので
$new_grow_level = 0 if($new_grow_level < 0);
$new_grow_level = $up_point - 1 if($new_grow_level >= $up_point);
$hist_str .= "음악이 「$pname」에게" . (
"꽤 좋다", "좋다", "좋다", "조금 좋다",
undef, "조금 나쁘다", "꽤 나쁘다"
)[$frt_type] . "영향을 주었습니다.
";
$rp->[4] = $new_grow_level;
put_plant_data($uid, $rplant);
}
}
my $rank_str = "($order_str位)" if($order_str);
$hist_str .= "오늘의 운세는 「"
. ("초대길", "대길", "중길", "소길", "길", "흉", "대흉")[$frt_type]
. "$rank_str」입니다.";
$hist_str .= get_item_change($rudata->[1], $frt_type);
$rudata->[0]->[9] = $u_time;
put_self_history($uid, $hist_str, "#006666");
}
return 1;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_item_change
{
my ($ruitem, $frt_type) = @_;
my $hist_str;
if($frt_type >= 5) {
my $pattern = int(rand() * 6);
if($pattern == 0) {
$hist_str .= "
오디오 세트가 망가져 버렸습니다.";
$ruitem->[8] = 0;
} elsif($pattern == 1 && $ruitem->[1] > 0) {
$hist_str .= "
거름이 너무 냄새나기 때문에 파기했습니다.($ruitem->[1]";
if($frt_type == 5){$ruitem->[1]--;} else {$ruitem->[1] = 0;}
$hist_str .= "→$ruitem->[1])";
} elsif($pattern == 2 && $ruitem->[2] > 0) {
$hist_str .= "
토양검사지의 색이 변색하고 있으므로 파기했습니다.($ruitem->[2]";
if($frt_type == 5){$ruitem->[2]--;} else {$ruitem->[2] = 0;}
$hist_str .= "→$ruitem->[2])";
} elsif($pattern == 3 && $ruitem->[3] > 0) {
$hist_str .= "
토양 분석 킷이 망가져 있던 것처럼 보였으므로 한 개 버렸습니다.($ruitem->[3]";
$ruitem->[3]--; $hist_str .= "→$ruitem->[3])";
} elsif($pattern == 4 && $ruitem->[5] > 0) {
$hist_str .= "
성장 촉진제의 소비 기한이 지나고 있었으므로 한 개 버렸습니다.($ruitem->[5]";
$ruitem->[5]--; $hist_str .= "→$ruitem->[5])";
} elsif($pattern == 5 && $ruitem->[7] > 0) {
$hist_str .= "
플랜트 하우스를 한개 잃어버렸습니다.($ruitem->[7]";
$ruitem->[7]--; $hist_str .= "→$ruitem->[7])";
}
} elsif($frt_type <= 1) {
my $pattern = int(rand() * 5);
if($pattern == 1 || $pattern == 3) {
if($frt_type == 0) {
$hist_str .= "
시작품의 성장 촉진제를 한 개 받아 왔습니다.(" . ($ruitem->[5] * 1);
$ruitem->[5]++; $hist_str .= "→$ruitem->[5])";
} else {
$hist_str .= "
손수 거름을 만들어 보았습니다. 거름이 한 개 증가했습니다. (" . ($ruitem->[1] * 1);
$ruitem->[1]++; $hist_str .= "→$ruitem->[1])";
}
} elsif($pattern == 2 || $pattern == 4) {
if($frt_type == 0) {
$hist_str .= "
토양 분석 킷을 친구로부터 받았습니다. 토양 분석 킷이 한 개 증가했습니다.(" . ($ruitem->[3] * 1);
$ruitem->[3]++; $hist_str .= "→$ruitem->[3])";
} else {
$hist_str .= "
토양검사지가 서랍에서 나왔습니다. 토양 리트머스지가 한 개 증가했습니다.(" . ($ruitem->[2] * 1);
$ruitem->[2]++; $hist_str .= "→$ruitem->[2])";
}
} elsif($pattern == 0) {
$hist_str .= "
왠지 플랜트 하우스가 하나 늘어있었습니다.럭키!(" . ($ruitem->[7] * 1);
$ruitem->[7]++; $hist_str .= "→$ruitem->[7])";
}
}
return $hist_str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_no_cook_htm
{
my $suid = $PARAM->{OPT};
my $str;
if(defined($suid)) {
$str = get_no_cook_main_htm($suid);
} else {
$str = get_no_cook_user_htm($PARAM->{UID}, $suid);
}
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_no_cook_main_htm
{
my $suid = shift;
my $rudata = get_status_data($suid);
my $uname = get_uname($suid);
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= get_hpb_js();
$str .= qq{
$uname의 믿을수 없는 식물
};
$str .= get_flower_htm($suid, $rudata);
$str .= get_ustatus_htm($suid, $rudata);
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_no_cook_user_htm
{
my ($uid, $suid) = @_;
my $ruids = get_ordered_udata();
my $rc = get_rc_data();
my $search_word = $PARAM->{WORD} if($PARAM->{WORD} eq get_safe_htm($PARAM->{WORD}));
$ruids = get_word_cut_udata($ruids) if($search_word);
my $href_str = qq{$PNAME?UID=$uid&MODE=no_cook&WORD=$search_word&SORT=};
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= get_hpb_js();
$str .= qq{
다른 사람의 믿을수 없는 식물
};
$str .= get_copyright();
$str .= "";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_rc_data
{
my @data = (['▼', 'd'], ['▼', 'd'], ['▼', 'd']);
my $sort = $PARAM->{SORT};
$data[0] = ['▲', 'a'] if($sort eq "id!d");
$data[1] = ['▲', 'a'] if($sort eq "al!d");
$data[2] = ['▲', 'a'] if($sort eq "ti!d");
return \@data;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_sow_item_htm
{
my $err_str;
my $uid = $PARAM->{UID};
my $rseed = get_seed_data($uid);
my $old_pid = $PARAM->{OPT};
my $new_pid = $PARAM->{IID};
my $rrseed = $rseed->{"$new_pid"};
if(!$rrseed->[1]) {
$err_str = "이용할 수 없는 종입니다";
} else {
my $rplant = get_plant_data($uid);
my $grow_step = $rplant->{"$old_pid"}->[5];
if ($grow_step != 6 && $grow_step != 10) {
$err_str = "그곳에 심을 수 없습니다";
} else {
my $rudata = get_status_data($uid);
$rudata->[0]->[5]--;
my $time = time;
my ($pname, $dna1, $dna2, $uid1, $uid2, $pid1, $pid2)
= (@$rrseed)[2, 3, 4, 6, 7, 8, 9];
my $price = get_flower_total($dna1, $dna2);
my $rdata = [$new_pid, $pname, $time, "null", 0, 0, 8, $time, $time, 8, $time,
$time, 8, $time, $time, 2, $dna1, $dna2, $price, $uid1, $uid2, $pid1, $pid2];
$rplant->{"$new_pid"} = $rdata;
make_flower_gif($uid, $rdata);
delete($rseed->{"$new_pid"});
delete($rplant->{"$old_pid"});
put_plant_data($uid, $rplant);
put_seed_data($uid, $rseed);
put_status_data($uid, $rudata);
put_self_history($uid, "$pname의 종을 심었습니다.", "black");
delete_image($uid, $old_pid);
}
}
my $str = get_main_htm($uid, $err_str);
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_use_item_htm
{
my $alert_str;
my $uid = $PARAM->{UID};
my $uname = get_uname($uid);
my $rseed = get_seed_data($uid);
if($PARAM->{RENAME}) {
$alert_str = change_seed_data($rseed, $uid);
put_seed_data($uid, $rseed);
}
my $ritem_shop = get_item_shop();
my $ruser = get_status_data($uid);
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= get_use_item_js();
$str .= get_hpb_js();
$str .= qq{
$unameの信じられない植物
};
$str .= get_flower_htm($uid, $ruser); #아이템 데이터가 변환됩니다
$str .= "$alert_str\n";
$str .= get_user_item_htm($uid, $ritem_shop, $ruser, $rseed);
$str .= get_ustatus_htm($uid, $ruser);
$str .= get_copyright();
$str .= "
";
put_status_data($uid, $ruser);
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_ustatus_htm
{
my ($uid, $rudata, $alert_str, $opt) = @_;
my $property_str;
my $udata = get_udata($uid);
my $img_dir = $RDATA->{img_dir};
my $rstatus = $rudata->[0];
my $announc_htm = get_announce_htm($uid, $rstatus)
if ($rstatus->[3] <= $RDATA->{hint} && $PARAM->{MODE} ne "no_cook");
my $uname_htm = get_uname_htm($udata);
if($opt->{property}) {
my $property = get_user_property($uid);
$property_str = qq{
재산：
| $property$RDATA->{monney} |
};
}
my $garden_name = ($PARAM->{MODE} eq "pollination")? "수분 작업":
($uid == $PARAM->{UID})? "마이 가든": "$udata->[1]씨의 가든";
my $level = $RDATA->{level_setting}->[$rstatus->[3]]->[0] || $RDATA->{kyuu}->[$rstatus->[3]];
my $str = qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_uname_htm
{
my $udata = shift;
my $ken;
my $uname = "$udata->[1] ";
if($udata->[9]) {
my ($url, $mail, $sex, $kent) = (@$udata)[3, 4, 5, 6];
$ken = "($kent)" if($kent && $kent ne "---");
$uname .= qq{ \n} if($mail);
$uname .= qq{ \n} if($url && $url ne "http://");
$uname .= qq{ \n} if($sex eq "남");
$uname .= qq{ \n} if($sex eq "여");
}
return "$uname$ken";
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_announce_htm
{
my ($uid, $rstatus) = @_;
my ($oji_say);
my $kyu = $rstatus->[3];
my $rplant = get_plant_data($uid);
my $roji = $RDATA->{oji_say};
foreach (values(%$rplant)) {
my ($grow_level, $place_score, $water_score, $nut_score, $place)
= (@$_)[5, 6, 9, 12, 15];
if(($grow_level == 10 || $grow_level == 6) && $rstatus->[5] >= 1) {
$oji_say .= $roji->{sow_seed} || "도구상자에 있는 종을 뿌리면, 또 식물이 자랄거야.";
} elsif($grow_level <= 5) {
if($kyu <= 3 && $place_score < 8 - $kyu) {
if($place == 3) {
$oji_say .= $roji->{move_in}
|| "식물을 집안에 이동시키는 편이 좋을 것 같은데.";
} elsif($place == 1) {
$oji_say .= $roji->{move_out}
|| "식물을 집 밖에 이동시키는 편이 좋을 것 같은데.";
}
} elsif($place_score <= 7) {
$oji_say .= $roji->{anal_item};
if(!$roji->{anal_item}) {
$oji_say .= (rand() < 0.7)? "
「토양시험지」나 「토양 분석 킷」을 사용하면, 식물을 집안에
두면 좋은 것인지, 밖에 내는 편이 좋은 것인지가 조사할 수 있지.
햇님 눈금이 올라 오고 있을 때, 장소를 바꾸어버리면 안된다고.
햇님 눈금이 내려가기 시작하면 바꿔봐.
": "
「토양시험지」는 결과가 정확하지도 하니까, 결과가 이상할 때는
몇 번인가 더 사용해봐서 잘 확인해 보는 편이 좋아.
";
}
}
if($kyu <= 3 && $water_score < 8 - $kyu) {
$oji_say .= "그리고, " if ($oji_say);
$oji_say .= $roji->{give_water} || "물을 주는 편이 좋은 것 같네";
}
if($kyu <= 3 && $nut_score < 8 - $kyu) {
$oji_say .= "또, " if ($oji_say);
$oji_say .= $roji->{give_nut} || "영양이 부족한거 같은데,
홈 센터로 가서 거름을 사 오고, 「도구상자」에서 줘보도록 해.";
}
}
}
my $level_s = $RDATA->{level_setting}->[0]->[0] || $RDATA->{kyuu}->[0];
my $level_e = $RDATA->{level_setting}->[$RDATA->{hint}]->[0] || $RDATA->{kyuu}->[$RDATA->{hint}];
my $announce = qq{
 |
${level_s}~${level_e}의 분들께,
농장의 할아버지로 부터의 힌트
$oji_say
|
|
} if($oji_say);
return $announce;
}
###################################################
# input:()
# retrun:
#comment:$cmd = w(물을 준다), p(장소를 이동한다)
###################################################
sub get_flower_htm
{
my ($uid, $rudata) = @_;
my ($str, $pre_alert_str);
my ($action_pid) = $PARAM->{OPT} =~ /^(\d+)!/;
my $time = time;
my $rstep = $RDATA->{step};
my $rplant = get_plant_data($uid);
my $rstatus = $rudata->[0];
if(($PARAM->{MODE} eq "use_item" || $PARAM->{MODE} eq "main") && $rplant->{"$action_pid"}) {
$pre_alert_str = change_plant_situation($rudata->[1],
$rplant->{"$action_pid"}, $uid);
put_plant_data($uid, $rplant);
}
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:자동적으로 나머지의 종을 자가수분 시켜 모두 팔았을 경우의 가격을 돌려준다
# 순계는 종을 잡히지 않기 때문에 0엔
###################################################
sub get_auto_seed_sell
{
my ($pure_flg, $rstatus, $rcreature) = @_;
my $rstat = get_flower_status_data($rcreature);
my $seed_rest = ($rstatus->[6] - $rstatus->[5])
* ($rstat->[0]->[0] - $RDATA->{plli_plice});
if($pure_flg || $seed_rest <= 0) {return undef;}
return $seed_rest;
}
###################################################
# input:()
# retrun:
#comment:$cmd = w(물을 준다), p(장소를 이동한다)
###################################################
sub change_plant_situation
{
my ($ritems, $rdata, $uid) = @_;
my $alert_str;
my ($pid, $option, $name) = split(/!/, $PARAM->{OPT});
my $place = $rdata->[15];
my $iid = $PARAM->{IID};
my $num = $PARAM->{NUM} || 1;
if(defined($iid)) {
if($ritems->[$iid] <= 0) {
return "利用できないアイテムです。";
# error_end(__LINE__, "부정한 아이템을 사용하려고 했습니다", "IID=$iid");
# exit 1;
}
}
if($PARAM->{MODE} eq "use_item") {
if($rdata->[5] < 0 || $rdata->[5] > 4) {return undef;}
if($iid == 1) {
if($rdata->[12] >= 9) {$alert_str = "더 이상 거름을 줄 수 없습니다.";}
else {
my $need_cnt = 9 - $rdata->[12];
my $use_max = ($ritems->[1] < $need_cnt)? $ritems->[1]: $need_cnt;
my $use_cnt = ($num < $use_max)? $num: $use_max;
$rdata->[12] += $use_cnt;
$ritems->[1] -= $use_cnt;
}
} elsif($iid == 2) {
my $flag = ($place == 1 || $place == 2)? 1: -1;
if(rand() < 0.2) {$flag = -$flag;}
my $place_good = ($flag == 1)?
"집 밖에 두는 편이 좋을 것 같습니다.": "집안에 두는 편이 좋을 것 같습니다.";
$alert_str = "토양시험지를 사용했습니다.
지금 이 식물은 $place_good";
$ritems->[2]--;
} elsif($iid == 3) {
my $flag = ($place == 1 || $place == 2)? 1: -1;
my $place_good = ($flag == 1)?
"집 밖에 두어 주세요.": "집안에 두어 주세요.";
$alert_str = "토양 분석 킷을 사용했습니다.
이 식물은 $place_good";
$ritems->[3]--;
} elsif($iid == 5) {
if(($rdata->[26] & 1) == 0) {
$rdata->[26] += 1;
$alert_str = "성장 촉진제를 사용했습니다.";
$ritems->[5]--;
} else {
$alert_str = "이 식물에는 이미 성장 촉진제가 사용되고 있습니다.";
}
} elsif($iid == 6) {
if(($rdata->[26] & 2) == 0) {
$rdata->[26] += 2;
$alert_str = "영양/보수제킷을 사용했습니다.";
$ritems->[6]--; $rdata->[12] = 9; $rdata->[9] = 9;
} else {
$alert_str = "이 식물에는 이미 영양/보수제킷이 사용되고 있습니다.";
}
} elsif($iid == 7) {
if(($rdata->[26] & 4) == 0) {
$rdata->[26] += 4;
$alert_str = "플랜트 하우스를 사용했습니다.";
$ritems->[7]--; $rdata->[6] = 9;
} else {
$alert_str = "이 식물에는 이미 플랜트 하우스가 사용되고 있습니다.";
}
}
} else {
$alert_str = change_plant_data($rdata, $uid); #여기서$rdata의 변경이 있으므로 주의!
if(defined($iid) && !defined($alert_str)) {$ritems->[$iid]--;}
}
return $alert_str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_top_plant_name_htm
{
my ($rdata, $pid, $cnt) = @_;
my $str;
if($PARAM->{MODE} eq "use_item") {
my $s_pid = (split(/!/, $PARAM->{OPT}))[0];
my $checked = ((!defined($s_pid) && $cnt == 0) || $s_pid == $pid)? "checked": "";
my $pname = $rdata->[1];
$str .= qq{
$pname
};
} elsif($PARAM->{MODE} eq "no_cook") {
my $pname = $rdata->[1];
$str .= qq{
$pname
};
} else {
$str .= qq{
의 모습
};
}
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_scale_htm
{
my $rdata = shift;
my $rscore_str = get_score_html($rdata);
my $str = qq{
$rscore_str->[0]
|
$rscore_str->[1]
|
$rscore_str->[2]
|
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:$place = 1:집밖, 2:집안
###################################################
sub get_time_bgcol
{
my ($time, $place) = @_;
my $res_col;
my $hour = (localtime($time))[2];
if($place <= 1) {
if (6 <= $hour && $hour < 17) {$res_col = "#ddeeee";}
elsif(17 <= $hour && $hour < 19) {$res_col = "#e3d2b5";}
else {$res_col = "#ffffdd";}
} else {
if (6 <= $hour && $hour < 17) {$res_col = "#ddffff";}
elsif(17 <= $hour && $hour < 19) {$res_col = "#ffdd99";}
else {$res_col = "#dadada";}
}
return $res_col;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_plant_delete_ok_htm
{
my $alert_str;
my $uid = $PARAM->{UID} * 1;
my $pid = $PARAM->{PID} * 1;
my $rplant = get_album_data($uid) if($uid);
if(my $rdata = $rplant->{"$pid"}) {
$alert_str = "「$rdata->[1]」을 앨범에서 삭제하였습니다.";
my $rudata = get_status_data($uid);
$rudata->[0]->[11] --;
put_status_data($uid, $rudata);
delete($rplant->{"$pid"});
put_all_album_data($uid, $rplant);
foreach my $organ (1, 2, 3) {
unlink("$RDATA->{album_img}/u$uid/p5_${organ}_${pid}.gif");
}
unlink("$RDATA->{album_img}/u$uid/bg_${pid}.gif");
renew_pure_number_data($uid, $rplant);
my @new_pop;
my $rpop = get_popular_flower();
foreach (@$rpop) {
push(@new_pop, $_) if($_->[0] != $uid || $_->[1] != $pid);
}
put_popular_flower(\@new_pop);
} else {
$alert_str = "그 식물은 삭제할 수 없습니다";
}
my $str = get_album_htm($alert_str);
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_plant_delete_check_htm
{
my ($alert_str) = @_;
my $uid = $PARAM->{UID} * 1;
my $pid = $PARAM->{PID} * 1;
my $width = ($RDATA->{album_span}) * 227;
my $rallu = get_all_udata_hash();
my $rsecret = get_secret_data();
my $rplant = get_album_data($uid);
my $rudata = get_status_data($uid);
add_album_expression_data($rplant);
my $rstatistics_bef = get_plant_statistics($rplant, $uid, $rsecret, $rudata);
my $rstatistics_aft = get_plant_statistics($rplant, $uid, $rsecret, $rudata, {"$pid" => 1});
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
사진 소거 확인 화면
$alert_str
| 삭제전의 집계 | |
};
$str .= get_totals_str($rstatistics_bef);
$str .= qq{ | | 삭제 후의 집계 | \n};
$str .= get_totals_str($rstatistics_aft);
$str .= "
";
$str .= get_plant_table_htm($uid, $pid, $rallu, $rsecret) if($pid);
$str .= qq{
|
이 식물을 삭제합니까?
};
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_no_cook_album_htm
{
my $str = get_album_htm(undef, is_cookie_ok());
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_album_htm
{
my ($alert_str, $cook_flg) = @_;
my $logo;
my $uid = $PARAM->{UID};
my ($suid, $mtype) = split(/!/, $PARAM->{OPT});
if($suid == 1) {
make_flower_shop(); #서둘러 꽃집을 준비
$logo = " ";
} else {
# $logo = "inc_plant.gif";
}
my $rplant = get_album_data($suid) if($suid);
add_album_expression_data($rplant);
if((my $pcost = int($PARAM->{CST})) && $uid == $suid && $cook_flg) {
if(my $rdata = $rplant->{"$PARAM->{PID}"}) {
my $max_pcost = $rdata->[23];
if($RDATA->{plli_plice} <= $pcost && $pcost <= $max_pcost) {
$rdata->[24] = $pcost;
put_all_album_data($uid, $rplant);
$alert_str = "$rdata->[1]의 교배료를 $pcost$RDATA->{monney}로 변경했습니다";
} else {
$alert_str = "$rdata->[1]의 교배료는 $RDATA->{plli_plice}-$max_pcost$RDATA->{monney}로 설정하여 주십시오.";
}
}
}
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
식물 앨범
$logo
$alert_str
};
if($suid) {
$str .= get_album_flower_htm($uid, $suid, $mtype, $rplant, $cook_flg);
} else {
$str .= get_album_user_htm($mtype);
}
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_album_flower_htm
{
my ($uid, $suid, $mtype, $rplant, $cook_flg) = @_;
my ($str, @totals);
my $rsecret = get_secret_data();
my $time = time;
my $property = get_user_property($uid) if($mtype eq "p");
my $mode = ($mtype eq "c")? "no_cook":
($mtype eq "a" || $mtype eq "p")? "album":
($mtype eq "b")? "bbs": "main";
my $href = "$PNAME?MODE=$mode&UID=$uid&PID=$PARAM->{PID}";
$href .= "&OPT=!p" if($mtype eq "p");
my $button_str = ($PARAM->{BT})?
qq{}:
qq{};
$str .= get_sort_link_htm($uid, $suid, $button_str);
my $rfpid = get_filtered_pid($rplant, $suid);
my $page_tr = get_page_link_htm($uid, scalar(keys(%$rfpid)));
$str .= $page_tr;
my $rpid = get_sort_pid($rplant);
my $rpid_ok = get_cut_ok_pid($rpid, $rfpid);
my $rudata = get_status_data($suid);
my $span = $RDATA->{album_span};
my $rstatistics = get_plant_statistics($rplant, $suid, $rsecret, $rudata);
my $cnt = 0;
foreach my $pid (@$rpid_ok) {
my $rdata = $rplant->{"$pid"};
my ($rcreature, $big_cost, $set_cost) = (@$rdata)[3, 23, 24];
my $pure_flg = (-e "$RDATA->{album_img}/u$suid/bg_${pid}.gif")? 1: 0;
my $rstat = get_flower_status_data($rcreature, $pure_flg);
my $is_secret = get_secret_type($rsecret, $rcreature);
my $seed_cost = ($uid == $suid)? $RDATA->{plli_plice}: $set_cost;
my $bgcol = get_flower_bgcolor($rcreature);
my $tr = ($cnt % $span == 0)? "": "";
my $etr = ($cnt % $span == $span - 1)? " ": "";
my $pname = $rdata->[1];
my ($bg_view, $icon_img);
if($pure_flg) {
$bg_view = "background='$RDATA->{album_img}/u$suid/bg_${pid}.gif'";
$icon_img = " ";
} else {
$bg_view = "bgcolor='$bgcol'";
}
$icon_img .= " " if($is_secret);
$icon_img .= "
\n" if($icon_img);
$str .= qq{
$tr
| $etr
};
$cnt++;
}
for(my $tr_cnt = 0; $tr_cnt < ($span - 1) - (($cnt - 1) % $span); $tr_cnt++) {
$str .= " | ";
}
my $total_str = qq{
} if($uid == $suid);
$total_str .= qq{
};
return $total_str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_album_top_htm
{
my ($uid, $suid, $mtype, $cook_flg) = @_;
my ($alb_subj, $alb_cmnt);
my $udata = get_udata($suid);
my $uname = $udata->[1];
if(!$cook_flg || $uid != $suid || $mtype eq "a" || $mtype eq "p") {
$alb_subj = "
$udata->[11]
"
if ($udata->[11]);
$alb_cmnt = "$udata->[12]" if ($udata->[12]);
} else {
my $js = "document.sbm.SBJ.value=this.form.sbj.value;";
$js .= "document.sbm.CMT.value=this.form.cmt.value;";
$js .= "document.sbm.submit();";
my $comment = $udata->[12]; $comment =~ s/
/\n/g;
$alb_subj = qq{
←표제(반각 50 문자까지)
};
$alb_cmnt = qq{
};
}
my $albt_str = "갱신 일시: " . get_daytime_str($udata->[13])
. "" if ($udata->[13]);
my $str = qq{
|
|
|
|
$uname씨의 앨범 |
|---|
| $alb_subj |
| $alb_cmnt |
$albt_str |
| |
|
|
|
|
|
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
# $rstat->[0] = [total_score, rep_id]
# ->[1] = [score, im_id]
# .
# .
# .
#
# $rtotals->[0]->[organ]->{im_id or rep_id} = 1
# ->[1]->[organ] = [total_score, min, max]
# ->[2] = total_big_cost
# ->[3] = total_set_cost
# ->[4] = plant_total_count
# ->[5] = 비밀수
###################################################
#sub add_totals
#{
# my ($rtotals, $rstat, $big_cost, $set_cost) = @_;
#
# for(my $cnt = 0; $cnt <= 3; $cnt++) {
# $rtotals->[0]->[$cnt]->{"$rstat->[$cnt]->[1]"} = 1;
# my $score = $rstat->[$cnt]->[0];
# $rtotals->[1]->[$cnt]->[0] += $score;
# my $min = $rtotals->[1]->[$cnt]->[1];
# $rtotals->[1]->[$cnt]->[1] = $score if(!$min || $min > $score);
# my $max = $rtotals->[1]->[$cnt]->[2];
# $rtotals->[1]->[$cnt]->[2] = $score if(!$max || $max < $score);
# }
# $rtotals->[2] += $big_cost;
# $rtotals->[3] += $set_cost;
# $rtotals->[4]++;
#
# return 1;
#}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_plant_statistics
{
my ($rplant, $uid, $rsecret, $rudata, $rcut_pid) = @_;
my (%sec_counter, @im_counter, @score);
my ($plant_cnt, $big_total_cost, $set_total_cost, $pure_cnt) = (0, 0, 0, 0);
while(my ($pid, $rdata) = each(%$rplant)) {
if(defined($rcut_pid) && $rcut_pid->{"$pid"}) {next;}
$plant_cnt ++;
my ($rcreature, $big_cost, $set_cost) = (@$rdata)[3, 23, 24];
my $sec_type = get_secret_type($rsecret, $rcreature);
$sec_counter{"$sec_type"} = 1 if($sec_type);
my $pure_flg = (-e "$RDATA->{album_img}/u$uid/bg_${pid}.gif")? 1: 0;
my $rstat = get_flower_status_data($rcreature, $pure_flg);
if($pure_flg) {
$pure_cnt ++;
} else {
$big_total_cost += $big_cost;
$set_total_cost += $set_cost;
}
for(my $cnt = 0; $cnt <= 3; $cnt++) {
my $im_id = $rstat->[$cnt]->[1];
$im_counter[$cnt]->{"$im_id"} = 1 if(defined($im_id));
my $each_score = $rstat->[$cnt]->[0];
$score[$cnt]->{total} += $each_score;
my $min = $score[$cnt]->{min};
$score[$cnt]->{min} = $each_score if(!$min || $min > $each_score);
my $max = $score[$cnt]->{max};
$score[$cnt]->{max} = $each_score if(!$max || $max < $each_score);
}
}
if($plant_cnt == 0) {return {};}
#순계만 남았을 경우 0으로 나누지 않게 1을 대입
my $pures = $plant_cnt - $pure_cnt || 1;
return {
plant_cnt => $plant_cnt,
plant_total => ($uid == 1)? undef: $rudata->[0]->[12],
plant_max => ($uid == 1)? undef: $rudata->[0]->[10],
secret_cnt => scalar(keys(%sec_counter)),
pure_cnt => scalar(keys(%{$im_counter[0]})),
stem_cnt => scalar(keys(%{$im_counter[1]})),
leaf_cnt => scalar(keys(%{$im_counter[2]})),
flower_cnt => scalar(keys(%{$im_counter[3]})),
set_ave_cst => int($set_total_cost / $pures + 0.5),
max_ave_cst => int($big_total_cost / $pures + 0.5),
total_score => {
max => $score[0]->{max},
min => $score[0]->{min},
ave => int($score[0]->{total} / $plant_cnt + 0.5),
},
strng_score => {
max => $score[1]->{max},
min => $score[1]->{min},
ave => int($score[1]->{total} / $plant_cnt + 0.5),
},
smell_score => {
max => $score[2]->{max},
min => $score[2]->{min},
ave => int($score[2]->{total} / $plant_cnt + 0.5),
},
beaut_score => {
max => $score[3]->{max},
min => $score[3]->{min},
ave => int($score[3]->{total} / $plant_cnt + 0.5),
},
};
}
###################################################
# input:()
# retrun:
#comment:album.cgi을 오픈
###################################################
sub get_pure_count
{
my ($rplant) = @_;
my %counter;
foreach (values(%$rplant)) {
my $rcreature = get_expression_data((@$_)[16, 17]);
if(defined(my $rep_id = get_represent_flower($rcreature))) {
$counter{"$rep_id"} = 1;
}
}
my $pure_count = keys(%counter);
return $pure_count;
}
###################################################
# input:()
# retrun:
#comment:album.cgi을 오픈
###################################################
sub renew_pure_number_data
{
my ($uid, $rplant) = @_;
my $pure_cnt = get_pure_count($rplant);
my $rusr_pure = get_user_pure_count_data();
$rusr_pure->{"$uid"} = $pure_cnt;
put_user_pure_count_data($rusr_pure);
return 1;
}
###################################################
# input:()
# retrun:
#comment:
# $rtotals->[0]->[organ]->{im_id or rep_id} = 1
# ->[1]->[organ] = [total_score, min, max]
# ->[2] = total_big_cost
# ->[3] = total_set_cost
# ->[4] = plant_total_count
###################################################
sub get_totals_str
{
my ($rstatis) = @_;
my $str;
my $plant_cnt = $rstatis->{plant_cnt};
# my ($rim, $rscore, $big_cst, $set_cst, $pln_cnt, $seq_num)
# = @$rtotals;
if(!$plant_cnt) {return "";}
# $seq_num = 0 if(!$seq_num);
$str .= qq{
| 식물수 |
비밀 |
순계수 |
종합 평가 |
꽃 |
아름다움 |
잎 |
향기 |
줄기 |
튼튼함 |
평균교배료 |
};
my $plant_max = "/$rstatis->{plant_max}" if($rstatis->{plant_max});
my $plant_total = "누계: $rstatis->{plant_total}뿌리
" if($rstatis->{plant_total});
$str .= qq{
$plant_total 보존: $plant_cnt$plant_max 뿌리 |
$rstatis->{secret_cnt}종 |
};
for(my $asc = 0; $asc <= 3; $asc++) {
my $cnt_typ = ("pure_cnt", "flower_cnt", "leaf_cnt", "stem_cnt")[$asc];
my $sta_typ = ("total_score", "beaut_score", "smell_score", "strng_score")[$asc];
$str .= qq{$rstatis->{$cnt_typ}종 | \n};
my $av_score = $rstatis->{$sta_typ}->{ave};
my $min_score = $rstatis->{$sta_typ}->{min};
my $max_score = $rstatis->{$sta_typ}->{max};
$str .= qq{
최고: $max_score
평균: $av_score
최저: $min_score
|
};
}
$str .= qq{
설정: $rstatis->{set_ave_cst}$RDATA->{monney}
최대: $rstatis->{max_ave_cst}$RDATA->{monney}
|
};
$str .= " |
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_sort_link_htm
{
my ($uid, $suid, $button_str) = @_;
my (@selected, @selcut);
my $bt = $PARAM->{BT}; my $opt = $PARAM->{OPT}; my $pid = $PARAM->{PID};
my $sort = $PARAM->{SORT}; my $cut = $PARAM->{CUT}; my $md = $PARAM->{MODE};
my $mode = ($md eq "ch_comment" || $md eq "album_del_ok")? "album": $PARAM->{MODE};
my $num = 0;
foreach ('picday!1!', 'tscore!1!', 'dtype!3!', 'dtype!2!', 'dtype!1!') {
$selected[$num] = "selected" if($sort =~ /^$_/); $num++;
}
$num = 1;
foreach ('p', 's') {
$selcut[$num] = "selected" if($cut eq $_); $num++;
}
my $add_str = qq{
} if($uid != 1 && $suid != 1);
my $href_str = qq{'$PNAME?MODE=$mode&UID=$uid&OPT=$opt&BT=$bt&PID=$pid&CUT='};
$href_str .= qq{+this.form.filter.options[this.form.filter.selectedIndex].value};
$href_str .= qq{+'&SORT='+this.form.pat.options[this.form.pat.selectedIndex].value};
my $col_span = $RDATA->{album_span};
my $str = qq{
|
|
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_page_link_htm
{
my ($uid, $plant_cnt) = @_;
my $md = $PARAM->{MODE};
my $bt = $PARAM->{BT};
my $opt = $PARAM->{OPT};
my $sort = $PARAM->{SORT};
my $cut = $PARAM->{CUT};
my $pid = $PARAM->{PID}; #교배시에 필요
my $mode = ($md eq "ch_comment" || $md eq "album_del_ok")? "album": $PARAM->{MODE};
my $suid = (split(/!/, $PARAM->{OPT}))[0];
my $pag = $PARAM->{PAGE}; $pag = 1 if($pag <= 0);
my $pgf = $RDATA->{album_span} * $RDATA->{album_step};
my $pg_cnt = int(($plant_cnt - 1 + $pgf) / $pgf);
my $bpag = $pag - 1; my $npag = $pag + 1;
my $bef = ($bpag == 0)? "＜": qq{＜};
my $nex = ($npag > $pg_cnt)? "＞": qq{＞};
my $str = qq{
|
합계 $pg_cnt 페이지：
$bef
};
for(my $pg = 1; $pg <= $pg_cnt; $pg++) {
$str .= ($pg != $pag)? qq{
$pg
}: "$pg ";
}
$str .= qq{
$nex
|
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_filtered_pid
{
my ($rplant, $uid) = @_;
my %new_pid;
my $cut_type = $PARAM->{CUT};
if($cut_type eq "p") {
foreach my $pid (keys(%$rplant)) {
if(-e "$RDATA->{album_img}/u$uid/bg_${pid}.gif") {
$new_pid{"$pid"} = 1;
}
}
} elsif($cut_type eq "s") {
my $rsecret = get_secret_data();
while(my ($pid, $rp) = each(%$rplant)) {
if(get_secret_type($rsecret, $rp->[3])) {
$new_pid{"$pid"} = 1;
}
}
} else {
foreach my $pid (keys(%$rplant)) {
$new_pid{"$pid"} = 1;
}
}
return \%new_pid;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_sort_pid
{
my $rplant = shift;
my @pids;
my ($sort_type, $opt, $sort_ad) = split(/!/, $PARAM->{SORT});
if($sort_type) {
my %sorter;
if($sort_type eq "tscore") {
foreach (values(%$rplant)) {
push(@{$sorter{"$_->[18]"}}, $_->[0]);
}
} elsif($sort_type eq "dtype") {
foreach (values(%$rplant)) {
my $val = $_->[3]->{"$opt"};
my $im_id = $val->{protein}->[$val->{view}->[0]]->{domain};
push(@{$sorter{"$im_id"}}, $_->[0]);
}
} else {
foreach (values(%$rplant)) {
push(@{$sorter{"$_->[25]"}}, $_->[0]);
}
}
if($sort_ad eq "a") {
foreach (sort {$a <=> $b} keys(%sorter)) {
foreach (@{$sorter{"$_"}}) {
push(@pids, $_);
}
}
} else {
foreach (reverse(sort {$a <=> $b} keys(%sorter))) {
foreach (@{$sorter{"$_"}}) {
push(@pids, $_);
}
}
}
} else {
if($sort_ad eq "a") {
@pids = sort {$a <=> $b} keys(%$rplant);
} else {
@pids = reverse(sort {$a <=> $b} keys(%$rplant));
}
}
return \@pids;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_cut_ok_pid
{
my ($rpid, $rfpid) = @_;
my @ok_pid;
my $pag = $PARAM->{PAGE}; $pag = 1 if($pag <= 0);
my $pgf = $RDATA->{album_span} * $RDATA->{album_step};
my $cnt = 0;
foreach (@$rpid) {
if(!$rfpid->{"$_"}) {next;}
if($cnt >= $pgf * ($pag - 1)) {
if($cnt >= $pgf * $pag) {last;}
push(@ok_pid, $_);
}
$cnt++;
}
return \@ok_pid;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_album_user_htm
{
my $mtype = $_[0] || "a";
my $str;
my $uid = $PARAM->{UID}; my $pid = $PARAM->{PID};
my $ruids = get_ordered_udata();
my $rc = get_rc_data();
my $search_word = $PARAM->{WORD} if($PARAM->{WORD} eq get_safe_htm($PARAM->{WORD}));
$ruids = get_word_cut_udata($ruids) if($search_word);
my $time = time;
my $href_str = qq{$PNAME?OPT=!$mtype&MODE=album&UID=$uid&PID=$pid&WORD=$search_word&SORT=};
my $add_url = "$PNAME?UID=$uid&MODE=main";
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_remove_time
{
my ($ac_time, $time) = @_;
my $rm_time;
my $left_time = $RDATA->{delete_time} - ($time - $ac_time);
if($left_time < 0) {
my $till_rm = $RDATA->{term} - ($time - get_routine_time());
$rm_time = "삭제까지 ${till_rm}초";
} elsif($left_time < 60) {
$rm_time = "${left_time}초";
} elsif($left_time < 3600) {
$rm_time = int($left_time / 60) . "분";
} elsif($left_time < 86400) {
$rm_time = int($left_time / 3600) . "시간";
} else {
$rm_time = int($left_time / 86400) . "일";
}
return $rm_time;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_flower_bgcolor
{
my ($rcreature) = @_;
my ($total, @rbg);
while(my ($organ_id, $val) = each(%$rcreature)) {
if($organ_id == 3) {$total += $val->{power} / 2;}
else {$total += $val->{power} / 4;}
$rbg[$organ_id - 1]
= sprintf("%x", (substr($val->{power} / 13, -1, 1) * 10
+ substr($val->{power} / 17, -2, 1)) % 52 + 204);
}
$total = int($total);
if($total <= 150) {return "#ccffff";}
# my $tmax_power = 255 / $RDATA->{max_power};
# while(my ($organ_id, $val) = each(%$rcreature)) {
# $rbg[$organ_id - 1]
# = sprintf("%x", int(255 - $val->{power} * $tmax_power));
# }
return "#$rbg[0]$rbg[1]$rbg[2]";
}
###################################################
# input:()
# retrun:
#comment:
#plantID,이름, 심은 초, null,성장 레벨, 성장 단계, 빛과 온도, 초, 체크한 초,
#수분, 초, 체크한 초, 영양, 초, 체크한 초, 장소, 유전자 1,유전자 2
###################################################
sub make_flower_gif
{
my ($uid, $rdata) = @_;
my $flower;
my $next_grow_step = $rdata->[5];
my $rcreature = get_expression_data((@$rdata)[16, 17]);
cp_flower_img($uid, $rdata->[0], $rcreature, $next_grow_step);
return 1;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub change_flower_type_data
{
my $rdata = shift;
my $rcreature = $rdata->[3];
my $rf_type = get_flower_type_data();
while(my ($organ_id, $val) = each(%$rcreature)) {
my $im_id = $val->{protein}->[$val->{view}->[0]]->{domain};
$rf_type->{"$organ_id"}->{"$im_id"}++;
}
put_flower_type_data($rf_type);
return 1;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_shop_htm
{
my $uid = $PARAM->{UID};
my $rseed = get_seed_data($uid);
my $ritem_shop = get_item_shop();
my $ruser = get_status_data($uid);
my $rstatus = $ruser->[0];
my $err_str = change_about_item($uid, $ruser, $ritem_shop, $rseed);
my $uname = get_uname($uid);
my $img_dir = $RDATA->{img_dir};
put_status_data($uid, $ruser);
my $level = $RDATA->{level_setting}->[$rstatus->[3]]->[0]
|| $RDATA->{kyuu}->[$rstatus->[3]];
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
아이템 샵
};
$str .= get_item_htm($uid, $ritem_shop, $ruser, $err_str);
$str .= get_user_item_htm($uid, $ritem_shop, $ruser, $rseed);
$str .= qq{
};
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:[[iid, 이름, 가격, 화상], ,,,]
###################################################
sub change_about_item
{
my ($uid, $ruser, $ritem_shop, $rseed) = @_;
my ($err_str);
my ($rstatus, $ritems) = @$ruser;
my $iid = $PARAM->{IID};
my $num = int($PARAM->{NUM}); $num = 1 if($num <= 0);
if($iid) {
if($PARAM->{MODE} eq "shop_sell") {
my ($e_name, $s_price)
= (@{$ritem_shop->[0]->{"$iid"}})[1, 5];
if($ritems->[$iid] <= 0) {
$err_str = "$e_name 을(를) 가지고 있지 않기 때문에 팔지 않습니다
\n";
}
if(!defined($err_str) && $s_price >= 0) {
$rstatus->[0] += $s_price;
$ritems->[$iid] --;
$err_str = "$e_name을(를) $s_price$RDATA->{monney}로 팔았습니다
\n";
}
} elsif($PARAM->{MODE} eq "seed_sell") {
if(!$rseed->{"$iid"}) {
$err_str = "팔아 버린 종, 또는 없는 종을 팔려고 했습니다";
} else {
my ($sell_flg, $p_name, $s_price) = (@{$rseed->{"$iid"}})[1, 2, 5];
if($sell_flg) {
$rstatus->[0] += $s_price;
$rstatus->[5]--;
delete($rseed->{"$iid"});
$err_str = "$p_name 의 종을 $s_price$RDATA->{monney} 로 팔았습니다
n";
put_seed_data($uid, $rseed);
} else {
$err_str = "앨범에 등록한 후에 팔아 주세요.
URL 인수의 부정 조작은 금지해 주십시오.";
}
}
} else {
my ($e_name, $e_price, $buy_max, $permit_kyu)
= (@{$ritem_shop->[0]->{"$iid"}})[1, 2, 4, 6];
if($rstatus->[3] < $permit_kyu) {$err_str = "구입할 수 없는 아이템입니다.";}
if(!$buy_max) {$buy_max = 10;}
if($e_price * $num > $rstatus->[0]) {
$err_str = "$e_name 을(를) 사기에는 소지금이 충분하지 않습니다
\n";
} elsif($iid != 4 && $buy_max < $ritems->[$iid] + $num) {
$err_str = "$e_name 은(는) 더 이상 가질 수 없습니다
\n";
} elsif($iid >= 11 && $iid <= 13) {
if($iid == 11 || $ritems->[$iid - 1]) {
my $next_cnt = $RDATA->{album_max}->[$iid - 10];
$rstatus->[10] = $next_cnt if($rstatus->[10] < $next_cnt);
} else {
$err_str = "구입할 수 없는 앨범입니다.";
}
} elsif($iid == 4) {
$buy_max = $rstatus->[8];
my $rplant = get_plant_data($uid);
my $plant_cnt = keys(%$rplant);
if($buy_max <= $plant_cnt) {
$err_str = "이 레벨에서는 $e_name은 이 이상 가질 수 없습니다
\n";
} else {
$rplant->{"-$plant_cnt"} = [-$plant_cnt, "새로운 화분", "null", "null", 0, 6, 9,
"null", "null", 9, "null", "null", 9, "null", "null", 0, "null", "null", 0];
put_plant_data($uid, $rplant);
}
}
if(!defined($err_str)) {
$rstatus->[0] -= $e_price * $num;
$ritems->[$iid] += $num;
$err_str = "$e_name 을(를) 구입했습니다.
\n";
if($iid == 4 && $ritems->[4] == 1) {
$err_str .= "
[힌트]
새로운 화분에 종을 심을 때, 물을";
$err_str .= "줄 때는
식물명의 좌측으로 라디오 버튼이 나타납니다.";
$err_str .= "
이것을 선택할 수 있습니다!
";
}
}
}
}
return $err_str;
}
###################################################
# input:()
# retrun:
#comment:[[iid, 이름, 가격, 화상], ,,,]
###################################################
sub get_item_htm
{
my ($uid, $ritem_shop, $ruser, $alert_str) = @_;
my $str;
my ($rstatus, $ritems) = @$ruser;
my $kyu = $rstatus->[3];
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:[[iid, 이름, 가격, 화상, 판매가], ,,,]
###################################################
sub get_user_item_htm
{
my ($uid, $ritem_shop, $ruser, $rseed) = @_;
my $str;
my ($rstatus, $ritems) = @$ruser;
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:[[iid, 이름, 가격, 화상, 판매가], ,,,]
###################################################
sub get_shop_uitem_htm
{
my ($uid, $ritem_shop, $ritems) = @_;
my $str;
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
#?seed data
# 0 1 2 3 4 5 6 7 8 9
#pid,이용 가능한가, 이름, 유전자 1,유전자 2,가격, 자신 uid,상대 uid,자신 pid,상대 pid
###################################################
sub get_seed_uitem_htm
{
my ($uid, $rseed, $rstatus) = @_;
my $str;
my $level = $RDATA->{level_setting}->[$rstatus->[3]]->[0]
|| $RDATA->{kyuu}->[$rstatus->[3]];
$str .= qq{
「${level}」이 가질 수 있는 종의 수는
$rstatus->[6]개 까지 입니다.
};
return $str;
}
###################################################
# input:()
# retrun: $items[0]->{iid} = [iid, name, price, img, urine]
# [1]->[n] = iid
#comment:
###################################################
sub get_item_shop
{
my @items;
open(SHOP, "$RDATA->{sys_dir}/shop.cgi")
|| error_end(__LINE__, "파일 에러", $!);
while(chomp(my $line = )) {
my @e_item = split(/\t/, $line);
my $iid = $e_item[0];
#V2.2 이전 호환이기 때문에
if(($iid == 11 || $iid == 12 || $iid == 13)
&& !defined($RDATA->{album_max}->[$iid - 10])) {next;}
$items[0]->{"$iid"} = \@e_item;
push(@{$items[1]}, $iid);
}
close(SHOP) || error_end(__LINE__, "파일 에러", $!);
return \@items;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_score_html
{
my $rdata = shift;
my @res_htms;
my @score = (@$rdata)[6, 9, 12];
my @gif_d = (
[
["bw", "bw", "bw", "bw", "bw", "bw", "yw", "yw", "rw"],
["bw", "bw", "bw", "bw", "bw", "bw", "yw", "yw", "rr"],
["bw", "bw", "bw", "bw", "bw", "bw", "yw", "yy", "rr"],
["bw", "bw", "bw", "bw", "bw", "bw", "yy", "yy", "rr"],
["bw", "bw", "bw", "bw", "bw", "bb", "yy", "yy", "rr"],
["bw", "bw", "bw", "bw", "bb", "bb", "yy", "yy", "rr"],
["bw", "bw", "bw", "bb", "bb", "bb", "yy", "yy", "rr"],
["bw", "bw", "bb", "bb", "bb", "bb", "yy", "yy", "rr"],
["bw", "bb", "bb", "bb", "bb", "bb", "yy", "yy", "rr"],
["bb", "bb", "bb", "bb", "bb", "bb", "yy", "yy", "rr"],
],
[
["bw", "bw", "bw", "bw", "yw", "yw", "yw", "yw", "rw"],
["bw", "bw", "bw", "bw", "yw", "yw", "yw", "yw", "rr"],
["bw", "bw", "bw", "bw", "yw", "yw", "yw", "yy", "rr"],
["bw", "bw", "bw", "bw", "yw", "yw", "yy", "yy", "rr"],
["bw", "bw", "bw", "bw", "yw", "yy", "yy", "yy", "rr"],
["bw", "bw", "bw", "bw", "yy", "yy", "yy", "yy", "rr"],
["bw", "bw", "bw", "bb", "yy", "yy", "yy", "yy", "rr"],
["bw", "bw", "bb", "bb", "yy", "yy", "yy", "yy", "rr"],
["bw", "bb", "bb", "bb", "yy", "yy", "yy", "yy", "rr"],
["bb", "bb", "bb", "bb", "yy", "yy", "yy", "yy", "rr"],
],
[
["bw", "bw", "bw", "bw", "yw", "yw", "yw", "yw", "rw"],
["bw", "bw", "bw", "bw", "yw", "yw", "yw", "yw", "rr"],
["bw", "bw", "bw", "bw", "yw", "yw", "yw", "yy", "rr"],
["bw", "bw", "bw", "bw", "yw", "yw", "yy", "yy", "rr"],
["bw", "bw", "bw", "bw", "yw", "yy", "yy", "yy", "rr"],
["bw", "bw", "bw", "bw", "yy", "yy", "yy", "yy", "rr"],
["bw", "bw", "bw", "bb", "yy", "yy", "yy", "yy", "rr"],
["bw", "bw", "bb", "bb", "yy", "yy", "yy", "yy", "rr"],
["bw", "bb", "bb", "bb", "yy", "yy", "yy", "yy", "rr"],
["bb", "bb", "bb", "bb", "yy", "yy", "yy", "yy", "rr"],
],
);
for(my $cnt = 0; $cnt < @score; $cnt++) {
my $each_score = $score[$cnt];
foreach (@{$gif_d[$cnt]->[$each_score]}) {
$res_htms[$cnt]
.= qq{
\n};
}
}
return \@res_htms;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_regist_jscript
{
my $str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_main_js
{
my $str = qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_hpb_js
{
my $img_dir = $RDATA->{img_dir};
my $str = qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_mail_js
{
my $str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_use_item_js
{
my $str = qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub add_album_expression_data
{
my $rplant = shift;
foreach (values(%$rplant)) {
$_->[3] = get_expression_data($_->[16], $_->[17]);
}
return 1;
}
###################################################
# input:()
# retrun:
#comment:
# $->{"organ_id"}->{protein}->[n] = quality
# ->{view} = [n,...]
# ->{power} = total_strength
###################################################
sub get_expression_data
{
my ($dna1, $dna2) = @_;
my %creature;
inc_inc::add_translated_gene_data(\%creature, $dna1);
inc_inc::add_translated_gene_data(\%creature, $dna2);
inc_inc::add_expression_data(\%creature);
return \%creature;
}
###################################################
# input:()
# retrun:
#comment:
# $->{"organ_id"}->{protein}->[n] = quality
# ->{view} = [n,...]
# ->{power} = total_strength
###################################################
sub get_flower_status
{
my ($rstat) = @_;
my $str;
my @organ = ("총합평가", "튼튼함(줄기)", "향기(잎)", "아름다움(꽃)");
$str .= "";
for(my $asc = 0; $asc <= 3; $asc++) {
my $cnt = (0, 3, 2, 1)[$asc];
my $add_str = "$organ[$cnt]: $rstat->[$cnt]->[0]
\n";
$add_str = "$add_str" if($cnt == 0);
$str .= $add_str;
}
$str .= "\n";
return $str;
}
###################################################
# input:()
# retrun: $->[0] = [total_score, rep_id]
# ->[1] = [score, im_id]
# ...
#comment:
# $->{"organ_id"}->{protein}->[n] = quality
# ->{view} = [n,...]
# ->{power} = total_strength
#
# pure_flg는 트리키 입니다.
###################################################
sub get_flower_status_data
{
my ($rcreature, $pure_flg) = @_;
my ($total, @temp);
while(my ($organ_id, $val) = each(%$rcreature)) {
$temp[$organ_id - 1]
= [$val->{power}, $val->{protein}->[$val->{view}->[0]]->{domain}];
if($organ_id == 3) {$total += $val->{power} / 2;}
else {$total += $val->{power} / 4;}
}
$total = int($total); $total *= $RDATA->{rep_rate} if($pure_flg);
for(my $cnt = 2; $cnt >= 0; $cnt--) {
$temp[$cnt]->[0] *= $RDATA->{rep_rate} if($pure_flg);
}
my $rep_id = get_represent_flower($rcreature) if($pure_flg);
return [[$total, $rep_id], @temp];
}
###################################################
# input:()
# retrun:[$dna1, $dna2, $total]
#comment:
###################################################
sub get_new_dna
{
my ($uid1, $pid1, $uid2, $pid2) = @_;
my (%creature);
my $rdna1 = get_new_haploid($uid1, $pid1, 0);
if(!$rdna1) {return undef;}
my ($dna1, $rdata1) = @$rdna1;
inc_inc::add_translated_gene_data(\%creature, $dna1);
my $rdna2 = get_new_haploid($uid2, $pid2, 1);
if(!$rdna2) {return undef;}
my ($dna2, $rdata2) = @$rdna2;
inc_inc::add_translated_gene_data(\%creature, $dna2);
inc_inc::add_expression_data(\%creature);
if($creature{"1"}->{power} * $creature{"2"}->{power} * $creature{"3"}->{power}) {
my $cost1 = $rdata1->[18];
# my $cost2 = $rdata2->[18];
my $total = $cost1; #최대 교배료는 자신의 식물의 평가에 의한다
return [$dna1, $dna2, $total];
}
return undef;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_new_haploid
{
my ($uid, $pid, $alb_flg) = @_;
my ($new_dna);
my $rplant = get_album_data($uid) if($alb_flg);
$rplant = get_plant_data($uid) if(!$alb_flg || !defined($rplant->{"$pid"}));
my $rdata = $rplant->{"$pid"};
if($rdata->[5] != 5) {return undef;}
my ($dna1, $dna2) = (@$rdata)[16, 17];
my $rcreature = get_expression_data($dna1, $dna2);
if(defined(get_represent_flower($rcreature))) {
return undef;
} else {
my $rchrom = inc_inc::get_chromosome_stracture([$dna1, $dna2]);
$new_dna = inc_inc::get_nbody_from_rchrom($rchrom);
}
return [$new_dna, $rdata];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_user_property
{
my ($uid) = @_;
my $property;
my $ritem_shop = get_item_shop();
my $ruser = get_status_data($uid);
my $rseed = get_seed_data($uid);
my ($rstatus, $ritems) = @$ruser;
my $rshop = $ritem_shop->[0];
for(my $iid = 1; $iid < @$ritems; $iid++) {
my $icnt = $ritems->[$iid];
my $sell_price = $rshop->{"$iid"}->[5];
if($icnt >= 1 && $sell_price >= 1) {
$property += $sell_price * $icnt;
}
}
foreach (values(%$rseed)) {
$property += $_->[5];
}
$property += $rstatus->[0];
return $property;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_all_user_property
{
my (@res, %table);
my $ruids = get_all_udata();
foreach (@$ruids) {
my $property = get_user_property($_->[0]);
push(@{$table{"$property"}}, $_)
if($property > $RDATA->{init_cash});
}
my $order = 1;
my @sorter = sort { $a <=> $b } keys(%table);
foreach my $property (reverse(@sorter)) {
foreach (@{$table{"$property"}}) {
my $suid = $_->[0];
my $rtag = get_tags($suid, $order);
push(@res, [$suid,
"$rtag->[2] $rtag->[0]$order위 $rtag->[1]",
"$rtag->[0]$_->[1]씨 $rtag->[1]",
"$rtag->[0]$property$RDATA->{monney}$rtag->[1]"
]);
}
if(++$order > 50) {last;}
}
return ["재산왕", ["순위", "이름", "재산"], \@res];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_all_user_flower_collection
{
my (@res, %table);
my $ruids = get_all_udata();
foreach (@$ruids) {
my %hana;
my $cnt = 0;
my $uid = $_->[0];
my $rplant = get_album_data($uid);
foreach (values(%$rplant)) {
my $rcreature = get_expression_data((@$_)[16, 17]);
my $rhana = $rcreature->{"3"};
my $flower = $rhana->{protein}->[$rhana->{view}->[-1]]->{domain};
if(!$hana{"$flower"}) {$hana{"$flower"} = 1; $cnt++;}
}
push(@{$table{"$cnt"}}, $_);
}
my $order = 1;
my @sorter = sort { $a <=> $b } keys(%table);
foreach my $property (reverse(@sorter)) {
if($property == 0) {next;}
foreach (@{$table{"$property"}}) {
my $suid = $_->[0];
my $rtag = get_tags($suid, $order);
push(@res, [$_->[0],
"$rtag->[2] $rtag->[0]$order위 $rtag->[1]",
"$rtag->[0]$_->[1]씨 $rtag->[1]",
"$rtag->[0]$property 종류 $rtag->[1]"
]);
}
if(++$order > 50) {last;}
}
return ["식물 콜렉터왕(보관 유지하고 있는'꽃'의 종류의 순위입니다.)",
["순위", "이름", "재배 식물"], \@res];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_all_user_collection
{
my (@res, %table);
my $ruids = get_all_udata();
foreach (@$ruids) {
my %hana;
my $rudata = get_status_data($_->[0]);
my $cnt = $rudata->[0]->[12];
push(@{$table{"$cnt"}}, $_);
}
my $order = 1;
my @sorter = sort { $a <=> $b } keys(%table);
foreach my $property (reverse(@sorter)) {
if($property == 0) {next;}
foreach (@{$table{"$property"}}) {
my $rtag = get_tags($_->[0], $order);
push(@res, [$_->[0],
"$rtag->[2] $rtag->[0]$order위 $rtag->[1]",
"$rtag->[0]$_->[1]씨 $rtag->[1]",
"$rtag->[0]${property}뿌리$rtag->[1]"
]);
}
if(++$order > 50) {last;}
}
return ["식물 콜렉터왕", ["순위", "이름", "재배 식물"], \@res];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_all_plant_score
{
my (@res, %table);
my $ruids = get_all_udata();
foreach (@$ruids) {
my $uid = $_->[0];
my $rplant = get_album_data($uid);
foreach my $rrplant (values(%$rplant)) {
my ($pid, $pname, $pcost) = (@$rrplant)[0, 1, 18];
push(@{$table{"$pcost"}}, [(@$_)[0, 1], $pid, $pname]);
}
}
my $order = 1;
my @sorter = sort { $a <=> $b } keys(%table);
foreach my $property (reverse(@sorter)) {
foreach (@{$table{"$property"}}) {
my ($suid, $pid) = (@$_)[0, 2];
my $rtag = get_tags($suid, $order);
my ($tags, $tage, $img) = @$rtag;
push(@res, [$suid, "$img $tags$order위 $tage",
"
$tags$_->[1]$tage${tags}씨의 $tage
$tags$_->[3]$tage
",
"$tags$property点$tage"
]);
}
if(++$order > 50) {last;}
}
return ["식물 종합 평가왕", ["순위", "식물의 이름", "종합 평가"], \@res];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_all_plant_score_no_pure
{
my (@res, %table);
my $ruids = get_all_udata();
foreach (@$ruids) {
my $uid = $_->[0];
my $rplant = get_album_data($uid);
foreach my $rrplant (values(%$rplant)) {
my ($pid, $pname, $pcost) = (@$rrplant)[0, 1, 18];
push(@{$table{"$pcost"}}, [(@$_)[0, 1], $pid, $pname]);
}
}
my $order = 1;
my @sorter = sort { $a <=> $b } keys(%table);
foreach my $property (reverse(@sorter)) {
my $order_flg = 0;
foreach (@{$table{"$property"}}) {
my ($suid, $pid) = (@$_)[0, 2];
next if(-e "$RDATA->{album_img}/u$suid/bg_${pid}.gif");
$order_flg = 1;
my $rtag = get_tags($suid, $order);
my ($tags, $tage, $img) = @$rtag;
push(@res, [$suid, "$img $tags$order위 $tage",
"
$tags$_->[1]$tage${tags}씨의 $tage
$tags$_->[3]$tage
",
"$tags$property점 $tage"
]);
}
if($order_flg) {if(++$order > 50) {last;}}
}
return ["식물 종합 평가왕(순계 식물을 제외한 평가의 순위입니다.)",
["순위", "식물의 이름", "종합 평가"], \@res];
}
###################################################
# input:()
# retrun:
#comment:파일 액세스를 축소하기 위해 장황하다
###################################################
sub get_all_popular_plant
{
my (%pops, %counter, %tmp, %table, @res);
my $rpop = get_popular_flower();
my $rallu = get_all_udata_hash();
foreach (@$rpop) {
$pops{"$_->[0],$_->[1]"} ++;
}
while(my ($upid, $count) = each(%pops)) {
push(@{$counter{"$count"}}, $upid);
}
my @sorter = sort { $a <=> $b } keys(%counter);
#파일 액세스 축소를 위한 늘어놓아 대체
my $order = 1;
foreach (@sorter) {
my $rupid = $counter{"$_"};
foreach my $upid (@$rupid) {
my ($uid, $pid) = split(/,/, $upid);
push(@{$tmp{"$uid"}}, [$pid, $_]);
}
if(++$order > 50) {last;}
}
while(my ($uid, $rpicnt) = each(%tmp)) {
my $rplant = get_album_data($uid);
foreach (@$rpicnt) {
my $uname = $rallu->{"$uid"}->[1];
$uname .= ($uname)? "씨": "플라워 팜";
push(@{$table{"$_->[1]"}},
[$uid, $uname, $_->[0], $rplant->{"$_->[0]"}->[1]]);
}
}
my $order = 1;
my @sorter = sort { $a <=> $b } keys(%table);
foreach my $pop_cnt (reverse(@sorter)) {
foreach (@{$table{"$pop_cnt"}}) {
my $suid = $_->[0];
my $rtag = get_tags($suid, $order);
push(@res, [$_->[0],
"$rtag->[2] $rtag->[0]$order위$rtag->[1]",
"$rtag->[0]$_->[1]의$_->[3]$rtag->[1]",
"$rtag->[0]$pop_cnt희$rtag->[1]"
]);
}
$order ++;
}
return ["교배 인기 식물왕(최근 인기가 있는 식물의 순위입니다.)",
["순위", "식물의 이름", "교배 회수"], \@res];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_all_pure_collector
{
my (@res, %table);
my $rusr_pure = get_user_pure_count_data();
my $rallu = get_all_udata_hash();
while(my ($uid, $pure_cnt) = each(%$rusr_pure)) {
push(@{$table{"$pure_cnt"}}, $uid);
}
my $order = 1;
my @sorter = sort { $a <=> $b } keys(%table);
foreach my $pure_cnt (reverse(@sorter)) {
if($pure_cnt == 0) {next;}
foreach (@{$table{"$pure_cnt"}}) {
my $rtag = get_tags($_, $order);
my $uname = $rallu->{"$_"}->[1];
push(@res, [$_,
"$rtag->[2] $rtag->[0]$order위 $rtag->[1]",
"$rtag->[0]$uname씨 $rtag->[1]",
"$rtag->[0]${pure_cnt}종류$rtag->[1]"
]);
}
if(++$order > 50) {last;}
}
return ["순계 식물 컬렉터왕", ["순위", "이름", "순계의 종류"], \@res];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_tags
{
my ($suid, $order) = @_;
my ($col, $tag_s, $tag_e, $imm);
if($PARAM->{UID} == $suid) {$col='red';}
if($order == 1) {
if(!defined($col)) {$col = '#999900';}
$imm = " ";
$tag_s = "";
$tag_e = "";
} elsif($order == 2) {
if(!defined($col)) {$col = '#553355';}
$imm = " ";
$tag_s = "";
$tag_e = "";
} elsif($order == 3) {
if(!defined($col)) {$col = '#990000';}
$imm = " ";
$tag_s = "";
$tag_e = "";
} elsif($col) {
$tag_s = "";
$tag_e = "";
}
return [$tag_s, $tag_e, $imm];
}
#####################################################################################################
###################################################
# input:()
# retrun:
#comment:
###################################################
sub delete_image
{
my ($uid, $pid) = @_;
foreach my $g_step (0, 1, 2, 3, 4, 6, 10) {
foreach my $organ (1, 2, 3) {
unlink("$RDATA->{album_img}/u$uid/p${g_step}_${organ}_${pid}.gif");
}
}
return 1;
}
###################################################
# input:()
# retrun:
#comment:
# $->{"organ_id"}->{protein}->[n] = quality
# ->{view} = [n,...]
# ->{power} = total_strength
#
#$grow_step：0:종,1:싹,2:본엽,3:풀,4:봉오리져,5:꽃,6:수확,10:
#$organ_id: 1:경,2:잎,3:꽃
###################################################
sub cp_flower_img
{
my ($uid, $pid, $rcreature, $grow_step) = @_;
while(my ($organ_id, $val) = each(%$rcreature)) {
my $im_id = $val->{protein}->[$val->{view}->[0]]->{domain};
cp_image($uid, $pid, $grow_step, $organ_id, $im_id);
}
return 1;
}
###################################################
# input:()
# retrun:
#comment:
#
#$grow_step：0:종,1:싹,2:본엽,3:풀,4:봉오리져,5:꽃,6:수확,10:
#$organ_id: 1:경,2:잎,3:꽃
###################################################
sub cp_image
{
my ($uid, $pid, $grow_step, $organ_id, $im_id) = @_;
my $cp_file = "$RDATA->{album_img}/u$uid/p${grow_step}_${organ_id}_${pid}.gif";
if(!(-e $cp_file)) {
my $file_path = "$RDATA->{plant_img}/o$grow_step/o${organ_id}_${im_id}.gif";
if(!(-e $file_path)) {
$file_path = "$RDATA->{plant_img}/o$grow_step/o${organ_id}_1.gif";
}
open(IN, "$file_path")
|| error_end(__LINE__, "파일 에러", "$!($file_path)");
binmode(IN);
open(OUT, ">$cp_file")
|| error_end(__LINE__, "파일 에러", "$!($cp_file)");
binmode(OUT);
my $buffer;
while(read(IN, $buffer, 1024)) {
print OUT $buffer;
}
close(OUT) || error_end(__LINE__, "파일 에러", $!);
close(IN) || error_end(__LINE__, "파일 에러", $!);
return 1;
}
return 0;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub cp_bg_img
{
my ($uid, $pid, $rep_id) = @_;
my $cp_file = "$RDATA->{album_img}/u$uid/bg_${pid}.gif";
my $file_path = "$RDATA->{plant_img}/obg/o$rep_id.gif";
open(IN, "$file_path")
|| error_end(__LINE__, "파일 에러", $!);
binmode(IN);
open(OUT, ">$cp_file")
|| error_end(__LINE__, "파일 에러", $!);
binmode(OUT);
my $buffer;
while(read(IN, $buffer, 1024)) {
print OUT $buffer;
}
close(OUT) || error_end(__LINE__, "파일 에러", $!);
close(IN) || error_end(__LINE__, "파일 에러", $!);
# system("cp $file_path $cp_file");
return 1;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub cp_pedia_img
{
my ($rep_id) = @_;
my $file_path = "$RDATA->{plant_img}/opure/o$rep_id.gif";
my $cp_file = "$RDATA->{album_img}/u0/o$rep_id.gif";
if(!(-e $cp_file)) {
open(IN, "$file_path")
|| error_end(__LINE__, "파일 에러", $!);
binmode(IN);
open(OUT, ">$cp_file")
|| error_end(__LINE__, "파일 에러", $!);
binmode(OUT);
my $buffer;
while(read(IN, $buffer, 1024)) {
print OUT $buffer;
}
close(OUT) || error_end(__LINE__, "파일 에러", $!);
close(IN) || error_end(__LINE__, "파일 에러", $!);
# system("cp $file_path $cp_file");
}
return 1;
}
###################################################
# input:()
# retrun:
#comment:
#plantID,이름, 심은 초, null,성장 레벨, 성장 단계, 빛과 온도, 초, 체크한 초,
#수분, 초, 체크한 초, 영양, 초, 체크한 초, 장소, 유전자 1,유전자 2
###################################################
sub get_flower_img_htm
{
my ($uid, $pid, $grow_step, $bg_view) = @_;
my $img_dir = $RDATA->{img_dir};
my $alb_dir = $RDATA->{album_img};
my ($htm_h, $htm_t);
for(my $organ_id = 1; $organ_id <= 3; $organ_id++) {
$htm_h .= qq{
|
} if($pid >= 0);
$htm_t .= qq{
|
} if($pid >= 0);
}
return ($uid <= 1)? qq{
$htm_h
$htm_t
|
|
}: qq{
|
$htm_h
$htm_t
|
|
};
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_help_htm
{
my $ritem_shop = get_item_shop();
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
아이템 헬프
| 아이템이름 |
매입가/판매가 |
최대 보유수 |
구입 레벨 |
설명 |
};
foreach (@{$ritem_shop->[1]}) {
my $ri = $ritem_shop->[0]->{"$_"};
my $sold_plice = ($ri->[5] >= 0)? "$ri->[5]$RDATA->{monney}": "팔지 않습니다.";
my $buy_max = ($ri->[0] == 4)? "---": $ri->[4] || 10;
my $level = ($ri->[0] == 4)? "---":
($RDATA->{level_setting}->[$ri->[6]]->[0] || $RDATA->{kyuu}->[$ri->[6]]);
$str .= qq{
$ri->[1] |
$ri->[2]$RDATA->{monney}/$sold_plice |
$buy_max |
$level |
$ri->[7] |
};
}
$str .= qq{
|
};
$str .= get_copyright();
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_parent_album_htm
{
my ($alert_str, $uid1, $uid2, $pid1, $pid2, $my_plant);
my ($uid, $pid) = ($PARAM->{UID}, $PARAM->{PID});
my $rsecret = get_secret_data();
my $rallu = get_all_udata_hash();
my $rseed = get_seed_data($uid);
my $rdata = $rseed->{"$pid"};
if(!defined($rdata)) {
my $rplant = get_plant_data($uid);
$rdata = $rplant->{"$pid"};
if(!defined($rdata)) {
my $ralbum = get_album_data($uid);
$rdata = $ralbum->{"$pid"} || error_end(__LINE__,
"그 식물은 존재하지 않습니다", "(uid, pid) = ($uid, $pid)", {file => "no"});
}
($uid1, $uid2, $pid1, $pid2) = (@$rdata)[19, 20, 21, 22];
$my_plant = $rdata->[1];
} else {
($uid1, $uid2, $pid1, $pid2) = (@$rdata)[6, 7, 8, 9];
$my_plant = $rdata->[2];
}
my $bk_btn_str
= qq{ }
if($PARAM->{BK});
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
植物家系?
};
$str .= get_copyright();
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_mono_album_htm
{
my ($pname, $bg_view, $flower_img, $flower_stat, $flower_pol, $icon_img);
my ($uid, $pid) = ($PARAM->{UID}, $PARAM->{PID});
my $rsecret = get_secret_data();
my $rallu = get_all_udata_hash();
my $alb_table_str = get_plant_table_htm($uid, $pid, $rallu, $rsecret);
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
식물의 표시
};
$str .= get_copyright();
$str .= qq{
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_plant_table_htm
{
my ($uid, $pid, $rallu, $rsecret) = @_;
my ($pname, $bg_view, $flower_img, $flower_stat, $flower_pol, $icon_img);
my $ralbum = get_album_data($uid);
my $rdata = $ralbum->{"$pid"};
my $my_plant = $rdata->[1];
my $uname = ($uid == 1)? "플라워 팜": qq{$rallu->{"$uid"}->[1]씨};
if(defined($rdata->[1])) {
my $rcreature = get_expression_data((@$rdata)[16, 17]);
my $bgcol = get_flower_bgcolor($rcreature);
$pname = qq{「}
. qq{$uname」の
「$rdata->[1]」};
my $pure_flg = (-e "$RDATA->{album_img}/u$uid/bg_${pid}.gif")? 1: 0;
if($pure_flg) {
$bg_view = "background='$RDATA->{album_img}/u$uid/bg_${pid}.gif'";
$icon_img = "";
} else {
$bg_view = "bgcolor='$bgcol'";
}
$icon_img .= ""
if(get_secret_type($rsecret, $rcreature));
$icon_img .= "
\n" if($icon_img);
$flower_img = get_flower_img_htm($uid, $pid, $rdata->[5], $bg_view);
my $rstat = get_flower_status_data($rcreature, $pure_flg);
$flower_stat = get_flower_status($rstat);
$flower_pol .= "
촬영일:
"
. get_day_str($rdata->[25]) . "
\n";
$flower_pol .= "
교배료: $rdata->[24]/$rdata->[23]
"
if(!$pure_flg);
} else {
$pname = "---";
$flower_img = qq{이 식물은 삭제되었습니다.};
}
my $str;
$str .= qq{
|
$pname
|
|
$flower_img
|
$icon_img
$flower_stat
$flower_pol
|
|
|
};
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_head
{
return qq{
};
}
#####################################################################################################
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_epass
{
my ($h_pass) = @_;
my @seeds = ( "A".."Z", "a".."z", "0".."9", ".", "/" );
my $seed = $seeds[int(rand(64))] . $seeds[int(rand(64))];
my $epasswd = crypt($h_pass, $seed);
return $epasswd;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_user_uranai
{
my ($uid) = @_;
my ($frt_type, $user_id, $fortune, $order_str);
if(-e "$RDATA->{data_dir}/uranai.cgi") {
open(IN, "$RDATA->{data_dir}/uranai.cgi")
|| error_end(__LINE__, "파일 에러", $!);
; #skip
while(chomp(my $line = )) {
($user_id, $fortune, $order_str) = split(/\t/, $line);
if($user_id == $uid) {last;}
}
close(IN) || error_end(__LINE__, "파일 에러", $!);
}
if($user_id != $uid) {
$fortune = rand();
$order_str = undef;
}
if($fortune < 1 / 30) {$frt_type = 6;} #대흉
elsif($fortune < 3 / 30) {$frt_type = 5;} #흉
elsif($fortune < 10 / 30) {$frt_type = 4;} #길
elsif($fortune < 20 / 30) {$frt_type = 3;} #소길
elsif($fortune < 25 / 30) {$frt_type = 2;} #중 길
elsif($fortune < 29 / 30) {$frt_type = 1;} #대길
else {$frt_type = 0;} #초대형길
return [$frt_type, $order_str];
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub make_uranai_data
{
my ($time) = @_;
my $btime = get_uranai_time();
if(!defined($btime) || int(($btime + $JST) / 86400) < int(($time + $JST) / 86400)) {
my %ft;
my $rallu = get_all_udata_hash();
my $num = 0;
foreach (values(%$rallu)) {
$num ++;
my $fortune = rand();
push(@{$ft{"$fortune"}}, $_);
}
my $order = $num;
open(OUT, ">$RDATA->{data_dir}/uranai.cgi")
|| error_end(__LINE__, "파일 에러", $!);
print OUT "$time\n";
foreach my $fortune (sort {$a <=> $b} keys(%ft)) {
foreach (@{$ft{"$fortune"}}) {
print OUT "$_->[0]\t$fortune\t$order/$num\n";
$order--;
}
}
close(OUT) || error_end(__LINE__, "파일 에러", $!);
}
return 1;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_uranai_time
{
my $btime;
if(-e "$RDATA->{data_dir}/uranai.cgi") {
open(IN, "$RDATA->{data_dir}/uranai.cgi")
|| error_end(__LINE__, "파일 에러", $!);
chomp($btime = );
close(IN) || error_end(__LINE__, "파일 에러", $!);
}
return $btime;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub make_backup_data
{
my ($time) = @_;
if((my $backup_dir = $RDATA->{backup}->{dir})
&& (my $time_span = $RDATA->{backup}->{span} * 60)) {
if(!(-e $backup_dir)) {return 0;}
my $btime = get_backup_time();
if(!defined($btime) || $btime + $time_span <= $time) {
unless(fork){
close(STDOUT);
my @data_time;
my $tar = $RDATA->{backup}->{tar} || "tar";
my $cmd1 = "$tar -czf $backup_dir/data$time.tgz $RDATA->{data_dir}";
my $cmd2 = "$tar -czf $backup_dir/img$time.tgz $RDATA->{album_img}";
system($cmd1); system($cmd2);
opendir(DIR, $backup_dir) || error_end(__LINE__, "opendir 에러", $!);
while (my $dir = readdir(DIR)) {
if(my ($dtime) = $dir =~ /^data(\d+)/) {
push(@data_time, $dtime);
}
}
closedir(DIR) || error_end(__LINE__, "closedir 에러", $!);
my @ftime = reverse(sort {$a <=> $b} @data_time);
for(my $cnt = 0; $cnt < @ftime; $cnt ++) {
if($RDATA->{backup}->{count} <= $cnt) {
unlink("$backup_dir/data$ftime[$cnt].tgz");
unlink("$backup_dir/img$ftime[$cnt].tgz");
}
}
exit 0;
}
open(OUT, ">$RDATA->{data_dir}/backup.cgi")
|| error_end(__LINE__, "파일 에러", $!);
print OUT "$time\n";
close(OUT) || error_end(__LINE__, "파일 에러", $!);
}
}
return 1;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_backup_time
{
my $btime;
if(-e "$RDATA->{data_dir}/backup.cgi") {
open(IN, "$RDATA->{data_dir}/backup.cgi")
|| error_end(__LINE__, "파일 에러", $!);
chomp($btime = );
close(IN) || error_end(__LINE__, "파일 에러", $!);
}
return $btime;
}
#####################################################################################################
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_server_select_htm
{
my $rserver = get_server_data();
my $uid = $PARAM->{UID};
my $pid = $PARAM->{PID};
my $site_url = "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}"; $site_url =~ s/\/\Q$PNAME\E//;
# my $uname = get_uname($uid);
my $ses_id = get_session_id($uid);
my $str = "Content-type: text/html\n\n";
$str .= qq{};
$str .= get_head();
$str .= qq{
믿을 수 없는 식물 서버 선택
};
$str .= get_copyright();
$str .= "
";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_server_login_htm
{
my ($res_str);
my $err_type = -1;
my $uid = $PARAM->{UID};
my $ses_id = get_session_id($uid);
if(!defined($ses_id) || $ses_id != $PARAM->{SESID}) {
$err_type = 1;
} else {
my $charge = $PARAM->{CHARGE};
my $ruser = get_status_data($uid);
my ($rstatus, $ritems) = @$ruser;
if($charge > $rstatus->[0]) {
$err_type = 2;
$res_str = "소지금이 충분하지 않습니다";
} elsif($rstatus->[5] >= $rstatus->[6]) {
$err_type = 3;
$res_str = "더 이상 종을 가질 수 없습니다";
} else {
$rstatus->[0] -= $charge;
put_status_data($uid, $ruser);
put_self_history($uid,
qq{다른 필드와 교배를 실시했습니다. 교배료와 중계료의 합계 $charge$RDATA->{monney}(을)를 지불했습니다}, "green"
);
}
}
my $str = "Content-type: text/plain\n\n";
$str .= "$err_type\n$res_str";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_server_payment_htm
{
my (%creature, $res_str);
my $err_type = -1;
my $rserver = get_server_data();
my $serv_key = $rserver->{"$PARAM->{URL}"}->[1];
my ($uid, $pid) = ($PARAM->{UID}, $PARAM->{PID});
my $rdna = get_new_haploid($uid, $pid, 1);
if(!$serv_key || $serv_key ne $PARAM->{KEY}) {
$err_type = 5;
$res_str = "정상적인 서버 정보를 얻을 수 없었습니다";
} elsif(!$rdna) {
$err_type = 4;
$res_str = "수분할 수 없는 종입니다"; #순계의 경우 등
} else {
my $sizerr_flg = 0;
my ($dna, $rdata) = @$rdna;
inc_inc::add_translated_gene_data(\%creature, $dna);
foreach (values(%creature)) {
foreach (@{$_->{protein}}) {
my $organ_id = $_->{organ};
my $im_id = $_->{domain};
my $tcript = $_->{transcript};
my $size = get_file_size($organ_id, $im_id);
if($size == 0) {$sizerr_flg = 1; last;}
$res_str .= "$tcript,$size|";
}
}
if($sizerr_flg) {
$err_type = 7;
$res_str = "이미지 데이터가 올바르지 않습니다.";
} else {
my $charge = $PARAM->{CHARGE};
my $rsplant = get_album_data($uid);
$rsplant = get_plant_data($uid) if(!defined($rsplant->{"$pid"}));
my ($pname, $def_seed_cost) = (@{$rsplant->{"$pid"}})[1, 24];
if($charge == $def_seed_cost) {
write_new_popflower($uid, $pid);
my $ruser = get_status_data($uid);
my ($rstatus, $ritems) = @$ruser;
$rstatus->[0] += $charge;
put_status_data($uid, $ruser);
put_self_history($uid,
qq{$PARAM->{FNAM}의}
. qq{$PARAM->{NAM}씨로부터 $pname의 교배료 $charge$RDATA->{monney}(을)를 받았습니다}, "green"
);
} else {
$err_type = 6;
$res_str = "교배료가 일치하지 않습니다.";
}
}
}
my $str = "Content-type: text/plain\n\n";
$str .= "$err_type\n$res_str";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_server_makeseed_htm
{
my ($err_type, $res_str);
my ($uid, $pid) = ($PARAM->{UID}, $PARAM->{PID});
my $new_dna = get_outer_dna_data();
my $rserver = get_server_data();
my $serv_key = $rserver->{"$PARAM->{URL}"}->[1];
if(!$serv_key || $serv_key ne $PARAM->{KEY}) {
$err_type = 5;
$res_str = "정상적인 서버 정보를 얻을 수 없었습니다";
} elsif(length($new_dna) != 53 * 5) {
$err_type = 8;
$res_str = "필드의 흙이 맞지 않는 것 같습니다.
수분에 실패해 버렸습니다.";
} elsif(my $rnew_dna = get_new_dna2($uid, $pid, $new_dna)) {
my $ruser = get_status_data($uid);
my $rstatus = $ruser->[0];
$rstatus->[5]++;
my $new_pid = ++$rstatus->[4];
my $rseed = get_seed_data($uid);
$rseed->{"$new_pid"} = [$new_pid, 0, "새로운 식물($new_pid)",
@$rnew_dna, $uid, undef, $pid, undef];
put_seed_data($uid, $rseed);
put_status_data($uid, $ruser);
$err_type = -1;
$res_str = "수분에 성공해, 종을 얻을 수 있었습니다.";
} else {
$err_type = 9;
$res_str = "수분에 실패해 버렸습니다.";
}
my $str = "Content-type: text/plain\n\n";
$str .= "$err_type\n$res_str\n";
return $str;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_outer_dna_data
{
my (@cres, $new_dna);
my $ok_cnt = 0;
foreach (split(/\|/, $PARAM->{HAPLOID})) {
my (%tmp_cre);
my ($tcript, $size) = split(/,/, $_);
inc_inc::add_translated_gene_data(\%tmp_cre, $tcript);
push(@cres, [\%tmp_cre, $size]);
}
my $rdnas = get_dna_data();
OUTER: foreach (@$rdnas) {
my %creature;
inc_inc::add_translated_gene_data(\%creature, $_->[0]);
foreach my $rcre (@cres) {
my ($rtmp_cre, $size) = @$rcre;
if(!$rtmp_cre) {next;}
my ($organ_id) = keys(%$rtmp_cre);
my $rrd = $rtmp_cre->{"$organ_id"};
foreach my $rd (@{$rrd->{protein}}) {
foreach (@{$creature{"$organ_id"}->{protein}}) {
if($rd->{domain} == $_->{domain} && $rd->{reaction} == $_->{reaction}
&& $size == get_file_size($organ_id, $_->{domain})) {
$new_dna .= $_->{transcript};
$rcre->[0] = undef;
$ok_cnt ++;
last;
}
}
if($ok_cnt == 5) {last OUTER;}
}
}
}
return $new_dna;
}
###################################################
# input:()
# retrun:[$dna1, $dna2, $total]
#comment:
###################################################
sub get_new_dna2
{
my ($uid1, $pid1, $dna2) = @_;
my (%creature);
my $rdna1 = get_new_haploid($uid1, $pid1, 0);
if(!$rdna1) {return undef;}
my ($dna1, $rdata1) = @$rdna1;
inc_inc::add_translated_gene_data(\%creature, $dna1);
inc_inc::add_translated_gene_data(\%creature, $dna2);
inc_inc::add_expression_data(\%creature);
if($creature{"1"}->{power} * $creature{"2"}->{power} * $creature{"3"}->{power}) {
#최대 교배료는 자신의 식물의 평가에 의한다
return [$dna1, $dna2, $rdata1->[18]];
}
return undef;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_file_size
{
my ($organ_id, $im_id) = @_;
my $file_path = "$RDATA->{plant_img}/o5/o${organ_id}_${im_id}.gif";
if(!(-e $file_path)) {
$file_path = "$RDATA->{plant_img}/o5/o${organ_id}_1.gif";
}
my $size = -s $file_path;
return $size;
}
#####################################################################################################
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_copyright
{
my $str = "
\n";
$str .= "\n";
# $str .= "| " . get_cpu_time() . "CPUs | \n";
$str .= "| $VERSION | \n";
foreach (@{$RDATA->{copyright}}) {
$str .= "| $_ | \n";
}
$str .= " \n";
return $str;
}
###################################################
# input:($type, $comment, $point)
# retrun:exit 1
#comment:에러 서브 루틴
###################################################
sub error_end
{
my ($point, $type, $comment, $opt) = @_;
$comment =~ s/\n/ /g;
my_funlock($LOCK) if(!defined($opt) || !$opt->{no_unlock});
my $file = (defined($opt) && $opt->{file})? $opt->{file}:
"$RDATA->{'data_dir'}/cgi.err";
sys_common::error_htm("$PNAME($VERSION)", $point, $type, $comment, {file => $file});
exit 1;
}
###################################################
# input:()
# retrun:
#comment:http://www.bayashi.net/st/pdmemo/filelock.html
# 에서 차용
# lockfile 자체가 없는 경우-1을 돌려주어, 이 경우 멘테중을 의미합니다.
###################################################
sub my_flock
{
my $lock;
my $times = 10;
my $break_time = $RDATA->{break_time} || 100;
my $lock_dir = $RDATA->{lock_dir};
my $filename;
opendir(LOCKDIR, $lock_dir);
while ($filename = readdir(LOCKDIR)) {
if($filename =~ /lockfile/) {last;}
}
closedir(LOCKDIR);
if(!defined($filename)) {return -1;}
my $lock_name = "$lock_dir/lockfile";
if ($filename =~ /^lockfile(\d+)/) {
return $lock if (time - $1 > $break_time &&
rename("$lock_name$1", $lock = $lock_name . time));
}
for (my $i = 0; $i < $times; $i++, sleep 1) {
return $lock if (rename($lock_name, $lock = $lock_name . time));
}
return undef;
}
sub my_funlock
{
my $lock = shift;
if(!rename($lock, "$RDATA->{lock_dir}/lockfile")) {
sys_common::write_log("$PNAME($VERSION)", "unlock",
"파일 파손의 가능성. break_time 의 값을 크게 해 주세요.",
{file => "$RDATA->{'data_dir'}/cgi.err", return => 1}
);
}
}
###################################################
# input:()
# retrun:
#comment:HTML의 이스케이프
###################################################
sub get_safe_htm
{
my ($str, $flg) = @_;
$str =~ s/&/&/g;
$str =~ s//>/g;
$str =~ s/\r\n|\r|\n|\t/
/g if($flg != 2);
$str =~ s/ / /g if(!$flg);
$str =~ s/"/"/g;
$str =~ s/'/'/g;
return $str;
}
##################################################
#input :
#return :
#comment:
##################################################
sub is_cookie_ok
{
my $uid = $PARAM->{UID};
my $rcook = get_cookie();
if($uid && $rcook->{UCK} eq "$uid\@" . get_session_id($uid))
{return 1;}
return 0;
}
##################################################
#input :
#return :
#comment:
##################################################
sub get_cookie
{
my $cookie_str = $ENV{'HTTP_COOKIE'};
my (%data, @cookie);
@cookie = split(/ /, $cookie_str);
foreach (@cookie) {
my ($name, $val) = split(/=/);
$val =~ s/;$//;
$data{$name} = $val;
}
return \%data;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_cpu_time
{
my @cpu = times();
return int(($cpu[0] + $cpu[1]) * 1000) / 1000;
}
###################################################
# input:()
# retrun:
#comment:
###################################################
sub get_taken_time
{
return time - $^T;
}
##################################################
#input :
#return :
#comment:
##################################################
sub get_time_str
{
my $time = shift;
my ($min, $hour, $mday, $mon) = (localtime($time))[1, 2, 3, 4];
$min = sprintf("%02d", $min);
$hour = sprintf("%02d", $hour);
$mday = sprintf("%02d", $mday);
$mon = $mon + 1;
my $time_str = "$mon월$mday일$hour시$min분";
return $time_str;
}
##################################################
#input :
#return :
#comment:
##################################################
sub get_day_str
{
my $time = shift;
my ($mday, $mon, $year) = (localtime($time))[3, 4, 5];
$mday = sprintf("%02d", $mday);
$mon = sprintf("%02d", $mon + 1);
my $time_str = ($year + 1900) . "년$mon월$mday일" ;
return $time_str;
}
##################################################
#input :
#return :
#comment:
##################################################
sub get_daytime_str
{
my $time = shift;
my ($sec, $min, $hour, $mday, $mon, $year)
= (localtime($time))[0, 1, 2, 3, 4, 5];
$sec = sprintf("%02d", $sec);
$min = sprintf("%02d", $min);
$hour = sprintf("%02d", $hour);
$mday = sprintf("%02d", $mday);
$mon = sprintf("%02d", $mon + 1);
my $time_str = ($year + 1900) . "/$mon/$mday $hour:$min:$sec" ;
return $time_str;
}
####################################################################################################
1;
| |
