Форум программистов, компьютерный форум, киберфорум
Наши страницы
PHP
Войти
Регистрация
Восстановить пароль
 
mutagen911
6 / 6 / 0
Регистрация: 09.06.2015
Сообщений: 17
#1

Код из perl в php - PHP

14.07.2018, 09:58. Просмотров 119. Ответов 2
Метки нет (Все метки)

Доброго времени суток.
Есть рабочий исходный код на Perl
Perl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
my @item = qw( xxx lit med hvy hax axe lax btx gix wnd
               ywn bwn clb mac whm fla mau ssd scm flc
               crs bsd lsd clm gsd dgr dir jav pil glv
               spr tri brn pik hal scy pax bst sst cst
               lst sbw lbw clw skr ktr axf sbb lbb lxb
               hxb ob1 ob3 ob4 am1 am2 am3 cap skp hlm
               fhl ghm crn msk emp xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx buc
               lrg kit tow bhm bsh spk dr1 dr4 dr3 ba1
               ba3 ba5 pa1 pa3 pa5 ne1 ne2 ne3 xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx ops gps opl
               gpl xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx
               xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx );
 
my %coftype=('hax'=>'1hs','axe'=>'1hs','wnd'=>'1hs','ywn'=>'1hs','bwn'=>'1hs',
             'clb'=>'1hs','mac'=>'1hs','whm'=>'1hs','fla'=>'1hs','ssd'=>'1hs',
             'scm'=>'1hs','flc'=>'1hs','crs'=>'1hs','bsd'=>'1hs','lsd'=>'1hs',
             'ob1'=>'1hs','ob3'=>'1hs','ob4'=>'1hs','clm'=>'2hs','gsd'=>'2hs',
             'dgr'=>'1ht','dir'=>'1ht','jav'=>'1ht','pil'=>'1ht','glv'=>'1ht',
             'ops'=>'1ht','gps'=>'1ht','opl'=>'1ht','gpl'=>'1ht','spr'=>'2ht',
             'tri'=>'2ht','brn'=>'2ht','pik'=>'2ht','am3'=>'2ht','mau'=>'stf',
             'lax'=>'stf','btx'=>'stf','gix'=>'stf','hal'=>'stf','scy'=>'stf',
             'pax'=>'stf','bst'=>'stf','sst'=>'stf','cst'=>'stf','lst'=>'stf',
             'am1'=>'bow','am2'=>'bow','sbw'=>'bow','lbw'=>'bow','sbb'=>'bow',
             'lbb'=>'bow','lxb'=>'xbw','hxb'=>'xbw','clw'=>'ht1','skr'=>'ht1',
             'ktr'=>'ht1','axf'=>'ht1','xxx'=>'hth');
 
my @class = qw( am so ne pa ba dz ai );
foreach my $d2sfile (@tmpary) {
  open (BIT, "$d2s_dir/$d2sfile") or die "Error: file $d2sfile not find";
  binmode BIT;
  seek (BIT,40,0);
  read (BIT,$cl,1);$cl=$class[ord($cl)];
  seek (BIT,136,0);
  read (BIT,$hd,1); $hd=$item[ord($hd)];
  read (BIT,$tr,1); $tr=$item[ord($tr)];
  read (BIT,$lg,1); $lg=$item[ord($lg)];
  read (BIT,$ra,1); $ra=$item[ord($ra)];
  read (BIT,$la,1); $la=$item[ord($la)];
  read (BIT,$rh,1); $rh=$item[ord($rh)];
  read (BIT,$lh,1); $lh=$item[ord($lh)];
  read (BIT,$sh,1); $sh=$item[ord($sh)];
  read (BIT,$s1,1); $s1=$item[ord($s1)];
  read (BIT,$s2,1); $s2=$item[ord($s2)];
  read (BIT,$s3,1); $s3=$item[ord($s3)];
  seek (BIT,152,0);
  read (BIT,$chd,1); $chd=sprintf ("%x",ord($chd));
  read (BIT,$ctr,1); $ctr=sprintf ("%x",ord($ctr));
  read (BIT,$clg,1); $clg=sprintf ("%x",ord($clg));
  read (BIT,$cra,1); $cra=sprintf ("%x",ord($cra));
  read (BIT,$cla,1); $cla=sprintf ("%x",ord($cla));
  read (BIT,$crh,1); $crh=sprintf ("%x",ord($crh));
  read (BIT,$clh,1); $clh=sprintf ("%x",ord($clh));
  read (BIT,$csh,1); $csh=sprintf ("%x",ord($csh));
  read (BIT,$cs1,1); $cs1=sprintf ("%x",ord($cs1));
  read (BIT,$cs2,1); $cs2=sprintf ("%x",ord($cs2));
  read (BIT,$cs3,1); $cs3=sprintf ("%x",ord($cs3));
  close BIT;
  binmode STDOUT;
 
foreach my $i ($hd,$tr,$la,$ra,$lg,$s1,$s2) {$i="lit" if $i eq "xxx";}
 
  $ctrh=$coftype{$rh};
  $ctlh=$coftype{$lh};
 
  if ($ctrh eq "hth" && $ctlh eq "hth")                                         {$ct="hth";}
  if ($ctrh eq "xbw" && $ctlh eq "xbw")                                         {$ct="xbw";}
  if ($ctrh eq "ht1" && $ctlh eq "ht1")                                         {$ct="ht2";}
  if (($ctrh eq "1hs" || $ctrh eq "2hs") && ($ctlh eq "1hs" || $ctlh eq "2hs")) {$ct="1ss";}
  if ($ctrh eq "1ht"  && $ctlh eq "1ht")                                        {$ct="1jt";}
  if (($ctrh eq "1hs" || $ctrh eq "2hs") && $ctlh eq "1ht")                     {$ct="1js";}
  if ($ctrh eq "1ht" && ($ctlh eq "1hs" || $ctlh eq "2hs"))                     {$ct="1st";}
  if ($ctrh ne "hth" && $ctlh eq "hth")                                         {$ct=$ctrh;}
  if ($ctrh eq "hth" && $ctlh ne "hth")                                         {$ct=$ctlh;}
  if ($ctrh eq "2hs" && $sh ne "xxx")                                           {$ct="1hs";}
  if ($ctlh ne "hth" && $sh ne "xxx")                                           {$ct="hth";$lh="xxx";}
На хосте где я хочу применить часть этого скрипта отсутствует поддержка Perl.
Работаю на тем что портировать скрипт на PHP.
Не разобрался с конструкцией foreach my $i ($hd,$tr,$la,$ra,$lg,$s1,$s2) {$i="lit" if $i eq "xxx";}.
В моём скрипте это место за комментировал.

PHP
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
$class = array("am","so","ne","pa","ba","dz","ai");
$item = array ("xxx","lit","med","hvy","hax","axe","lax","btx","gix","wnd",
               "ywn","bwn","clb","mac","whm","fla","mau","ssd","scm","flc",
               "crs","bsd","lsd","clm","gsd","dgr","dir","jav","pil","glv",
               "spr","tri","brn","pik","hal","scy","pax","bst","sst","cst",
               "lst","sbw","lbw","clw","skr","ktr","axf","sbb","lbb","lxb",
               "hxb","ob1","ob3","ob4","am1","am2","am3","cap","skp","hlm",
               "fhl","ghm","crn","msk","emp","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","buc",
               "lrg","kit","tow","bhm","bsh","spk","dr1","dr4","dr3","ba1",
               "ba3","ba5","pa1","pa3","pa5","ne1","ne2","ne3","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","ops","gps","opl",
               "gpl","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx",
               "xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx","xxx");
$coftype = array ('hax'=>'1hs','axe'=>'1hs','wnd'=>'1hs','ywn'=>'1hs','bwn'=>'1hs',
            'clb'=>'1hs','mac'=>'1hs','whm'=>'1hs','fla'=>'1hs','ssd'=>'1hs',
            'scm'=>'1hs','flc'=>'1hs','crs'=>'1hs','bsd'=>'1hs','lsd'=>'1hs',
            'ob1'=>'1hs','ob3'=>'1hs','ob4'=>'1hs','clm'=>'2hs','gsd'=>'2hs',
            'dgr'=>'1ht','dir'=>'1ht','jav'=>'1ht','pil'=>'1ht','glv'=>'1ht',
            'ops'=>'1ht','gps'=>'1ht','opl'=>'1ht','gpl'=>'1ht','spr'=>'2ht',
            'tri'=>'2ht','brn'=>'2ht','pik'=>'2ht','am3'=>'2ht','mau'=>'stf',
            'lax'=>'stf','btx'=>'stf','gix'=>'stf','hal'=>'stf','scy'=>'stf',
            'pax'=>'stf','bst'=>'stf','sst'=>'stf','cst'=>'stf','lst'=>'stf',
            'am1'=>'bow','am2'=>'bow','sbw'=>'bow','lbw'=>'bow','sbb'=>'bow',
            'lbb'=>'bow','lxb'=>'xbw','hxb'=>'xbw','clw'=>'ht1','skr'=>'ht1',
            'ktr'=>'ht1','axf'=>'ht1','xxx'=>'hth');
 
$fp = fopen( $file_char, 'rb');
$contents = fread($fp, filesize($file_char));
fclose ($fp);
 
$block = substr ($contents,0,767);
$cl = hexdec (bin2hex (substr ($block,40,1)));
$b16char = substr ($block,136,16);
$b16color = substr ($block,152,16);
 
$hd = hexdec (bin2hex (substr ($b16char,0,1)));
$tr = hexdec (bin2hex (substr ($b16char,1,1)));
$lg = hexdec (bin2hex (substr ($b16char,2,1)));
$ra = hexdec (bin2hex (substr ($b16char,3,1)));
$la = hexdec (bin2hex (substr ($b16char,4,1)));
$rh = hexdec (bin2hex (substr ($b16char,5,1)));
$lh = hexdec (bin2hex (substr ($b16char,6,1)));
$sh = hexdec (bin2hex (substr ($b16char,7,1)));
$s1 = hexdec (bin2hex (substr ($b16char,8,1)));
$s2 = hexdec (bin2hex (substr ($b16char,9,1)));
$s3 = hexdec (bin2hex (substr ($b16char,10,1)));
 
$chd = sprintf ("%x", hexdec (bin2hex (substr ($b16color,0,1))));
$ctr = sprintf ("%x", hexdec (bin2hex (substr ($b16color,1,1))));
$clg = sprintf ("%x", hexdec (bin2hex (substr ($b16color,2,1))));
$cra = sprintf ("%x", hexdec (bin2hex (substr ($b16color,3,1))));
$cla = sprintf ("%x", hexdec (bin2hex (substr ($b16color,4,1))));
$crh = sprintf ("%x", hexdec (bin2hex (substr ($b16color,5,1))));
$clh = sprintf ("%x", hexdec (bin2hex (substr ($b16color,6,1))));
$csh = sprintf ("%x", hexdec (bin2hex (substr ($b16color,7,1))));
$cs1 = sprintf ("%x", hexdec (bin2hex (substr ($b16color,8,1))));
$cs2 = sprintf ("%x", hexdec (bin2hex (substr ($b16color,9,1))));
$cs3 = sprintf ("%x", hexdec (bin2hex (substr ($b16color,10,1))));
 
$class = $class [$cl];
$hd = $item [$hd];
$tr = $item [$tr];
$lg = $item [$lg];
$ra = $item [$ra];
$la = $item [$la];
$rh = $item [$rh];
$lh = $item [$lh];
$sh = $item [$sh];
$s1 = $item [$s1];
$s2 = $item [$s2];
$s3 = $item [$s3];
 
$i = array ($hd,$tr,$la,$ra,$lg,$s1,$s2);
 
# foreach ($i)
#   {
#       if ($i == "xxx") {$i="lit"};
#   }
 
 
$ctrh = $coftype [$rh];
$ctlh = $coftype [$lh];
В PHP оператор цикла foreach применяется только для массивов. Как я понимаю в скрипте на Perl массив формируется прямо в теле цикла. В моём скрипте, массив сформирован перед циклом ( $i = array ($hd,$tr,$la,$ra,$lg,$s1,$s2); ). Не могу понять условие в теле цикла $i="lit" if $i eq "xxx". Как я понимаю, если элемент массива $i == "xxx" то заменить этот элемент на $i="lit".

Как правильно эту часть кода грамотно портировать на PHP?
Perl я только начал осваивать.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
14.07.2018, 09:58
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Код из perl в php (PHP):

Perl к PHP
Здравствуйте как перевести из Perl к Php или есть какие то трансляторы можете...

Запуск perl скрипта из php
Привет друзья! Прошу сразу не пинать. т.к. опробовал просто все варианты...

Друзья необходим код php. Формы и файлы в PHP
1. Имеется упорядоченный файл. Вставить в него заданное число таким образом,...

Друзья необходим код php. Формы и файлы в PHP
1. Составить программу, благодаря которой пользователь может выбрать стиль...

Одинаковый php код, но в разных PHP файлах
Добрый вечер! Есть файл ac.php, он лежит в корне сайта, я взял и скопировал...

PHP 5.5. При замене "<?php" на '<?' код перестал интерпретироваться
Доброго времени суток, коллеги. Возможно подниму глупую тему, но поиск в гугле...

2
Emilien
497 / 401 / 233
Регистрация: 07.11.2015
Сообщений: 644
14.07.2018, 12:39 #2
PHP
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
function __($char, $item){
    $r = $item[ord($char)];
    return ($r === "xxx") ? "lit" : $r;
}
 
$block = substr($contents,0,767);
$cl = $class[ord($block[40])];
$b16char = substr ($block,136,16);
$b16color = substr ($block,152,16);
 
$hd = __($b16char[0], $item);
$tr = __($b16char[1], $item);
$lg = __($b16char[2], $item);
$ra = __($b16char[3], $item);
$la = __($b16char[4], $item);
$rh = __($b16char[5], $item);
$lh = __($b16char[6], $item);
$sh = __($b16char[7], $item);
$s1 = __($b16char[8], $item);
$s2 = __($b16char[9], $item);
$s3 = __($b16char[10], $item);
 
$chd = sprintf ("%x", ord($b16color[0]));
$ctr = sprintf ("%x", ord($b16color[1]));
$clg = sprintf ("%x", ord($b16color[2]));
$cra = sprintf ("%x", ord($b16color[3]));
$cla = sprintf ("%x", ord($b16color[4]));
$crh = sprintf ("%x", ord($b16color[5]));
$clh = sprintf ("%x", ord($b16color[6]));
$csh = sprintf ("%x", ord($b16color[7]));
$cs1 = sprintf ("%x", ord($b16color[8]));
$cs2 = sprintf ("%x", ord($b16color[9]));
$cs3 = sprintf ("%x", ord($b16color[10]));
 
$ctrh = $coftype [$rh];
$ctlh = $coftype [$lh];
1
mutagen911
6 / 6 / 0
Регистрация: 09.06.2015
Сообщений: 17
15.07.2018, 14:51  [ТС] #3
Emilien, некорректно работает этот вариант кода.
Мой хоть и длиннее, но работает.

Проблему цикла пока решил в такой форме:
PHP
1
2
3
4
5
6
7
8
9
10
11
12
$i = array ($hd,$tr,$la,$ra,$lg,$s1,$s2);
foreach ($i as &$var)
    {
        if ($var == "xxx") $var = "lit";
    }
$hd = $i[0];
$tr = $i[1];
$lg = $i[4];
$ra = $i[3];
$la = $i[2];
$s1 = $i[5];
$s2 = $i[6];
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
15.07.2018, 14:51
Привет! Вот еще темы с решениями:

Код в php
Привет Всем! Подскажите пожалуйста, есть такой php код...

Зашифрованный php код
Всем привет, вот есть код: &lt;?php...

Код javascript в PHP
Привет всем! Подскажите пожалуйста..... Есть такой код Код (Text): ...

Простенький код на PHP
Всем привет, перейду сразу к делу &lt;?php $domain = &quot;gruppatest99977&quot;; $url...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru