Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / PHP, Perl, Python [игнор отключен] [закрыт для гостей] / Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru) / 21 сообщений из 21, страница 1 из 1
11.10.2012, 10:34
    #37993146
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Есть система (IPTV Portal), предоставляющая API в виде JSON-SQL (JSON-RPC, манипулирующий SQL-запросами).
Использую такой код:
Код: php
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
#!/usr/bin/perl -w

use strict;
use warnings;

use JSON::RPC::Client;
use Data::Dumper;

my $api = new JSON::RPC::Client;
my $domain = 'xxx';
my $username = 'xxx';
my $password = 'xxx';
my $url = "https://admin.$domain.iptvportal.ru/api/jsonsql";

$api->version('2.0');
$api->ua()->ssl_opts(verify_hostname=>0);
$api->prepare($url, ['authorize_user','select','insert','update','delete']);

$api->id(1);
$api->authorize_user( {username=>$username, password=>$password} );


На последней строке получаю такую ошибку:
Код: plaintext
malformed JSON string, neither array, object, number, string or atom, at character offset 0 (before "<!DOCTYPE HTML PUBLI...") at /usr/lib/perl5/site_perl/5.14.2/JSON/RPC/Client.pm line 186.

Есть предположения, почему я получаю ошибку?

________________________
Мы смотрим с оптимизмом...
...в оптический прицел.
...
Рейтинг: 0 / 0
11.10.2012, 11:08
    #37993212
r u
r u
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Alibek B.,

мне кажется в коде ошибки все и написано.

при обращении по этому адресу ожидается получить корректный json , а вываливается какойто html "<!DOCTYPE HTML PUBLI..."

чтото недонастроено
...
Рейтинг: 0 / 0
11.10.2012, 18:00
    #37994286
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Выяснилось, что я просто использовал неправильный URL.
Для авторизации используется " https://admin.$domain.iptvportal.ru/api/jsonrpc/", а для дальнейшей работы " https://admin.$domain.iptvportal.ru/api/jsonsql/".
...
Рейтинг: 0 / 0
13.10.2012, 10:22
    #37996745
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Еще один вопрос по JSON-RPC.
К сервису имеется API и описание доступных таблиц и полей.
В таблице media есть поле encrypted, у него указан тип данных boolean.
Серверная часть реализована судя по всему на PHP.
В Perl такого типа данных (boolean) нет, если я указываю 0 или 'false', то получаю ошибку процедуры.
Если сделать SELECT для записи, где заполнено это поле, то получаю следующее (поле encrypted — 7 по счету):
Код: php
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
$VAR1 = [
          [
            10972,
            'Камера 001',
            '239.0.1.1',
            'udp',
            1234,
            undef,
            bless( do{\(my $o = 0)}, 'JSON::XS::Boolean' ),
            undef,
            undef,
            undef
          ],
        ];



Подскажите, как мне в INSERT и UPDATE запросах задавать правильный тип данных для boolean-полей? Если использовать выражение "bless( do{\(my $o = 0)}, 'JSON::XS::Boolean' )", то оно работает, но как-то громоздко.
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
27.07.2015, 14:30
    #39016796
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Такой вопрос.

В JSON-RPC можно работать в пакетном режиме , в этом случае вместо объекта я передаю массив объектов:
Код: javascript
1.
2.
3.
4.
5.
6.
7.
8.
[
        {"jsonrpc": "2.0", "method": "sum", "params": [1,2,4], "id": "1"},
        {"jsonrpc": "2.0", "method": "notify_hello", "params": [7]},
        {"jsonrpc": "2.0", "method": "subtract", "params": [42,23], "id": "2"},
        {"foo": "boo"},
        {"jsonrpc": "2.0", "method": "foo.get", "params": {"name": "myself"}, "id": "5"},
        {"jsonrpc": "2.0", "method": "get_data", "id": "9"} 
    ]


и получаю, соответственно, массив ответов.
Однако в JSON::RPC::Client при попытке передать массив я получаю ошибку "not hashref.".
Судя по исходному коду JSON::RPC::Client работа в пакетном режиме в нем не предусмотрена:
Код: php
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
    my ($self, $uri, $obj) = @_;
    my $result;

    if ($uri =~ /\?/) {
       $result = $self->_get($uri);
    }
    else {
        Carp::croak "not hashref." unless (ref $obj eq 'HASH');
        $result = $self->_post($uri, $obj);
    }



Не посоветуете библиотеку для работы с JSON-RPC?
Или тут придется писать свой код?
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
05.08.2016, 16:40
    #39287399
alexeypp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Alibek B., не поделитесь остальным кодом взаимодействия с IPTV Pщкефд на PERL?
Я как раз сейчас изобретаю этот велосипед...
...
Рейтинг: 0 / 0
05.08.2016, 17:44
    #39287463
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Что-то такое:

Код: 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.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
### IPTVPortal Middleware module
### Version 0.1.0001, date 2015-07-25
### Author: Alibek Bolatov <alibek@mail.ru>;

# Кодировка UTF-8, формат файла Unix

=encoding UTF-8

=pod

История изменений

=over

=item 0.1.0001 2015-07-25
  Первый релиз

=back

=cut

use utf8;
use strict;
use warnings;

package IPTVPortal;

use boolean;
use Encode;
use JSON;
use Tie::IxHash;
use Digest::MD5 qw(md5_hex);
use URI::Escape;
use LWP::UserAgent;
use HTTP::Request;
use Data::Dumper;
$Data::Dumper::Useperl = 1;
{
	no warnings 'redefine';
	sub Data::Dumper::qquote {return "'$_[0]'";}
}

my $cfg = {};

sub _init(;$)
{
	my $domain = (shift||"provider");
	$cfg->{'rpc'} = {};
	$cfg->{'rpc'}->{'domain'} = $domain;
	$cfg->{'rpc'}->{'address'} = "https://admin.$cfg->{'rpc'}->{'domain'}.iptvportal.ru";
	$cfg->{'rpc'}->{'username'} = "admin";
	$cfg->{'rpc'}->{'password'} = "password";
	$cfg->{'rpc'}->{'api'} = "/api/jsonrpc/";
	$cfg->{'rpc'}->{'sql'} = "/api/jsonsql/";
	$cfg->{'rpc'}->{'expire'} = 86400;
	$cfg->{'rpc'}->{'version'} = "2.0";
}

sub new
{
	{
		my ($type,$section,$name);
		my $map = sub
		{
			my $type = shift;
			my $data = shift;
			my %map = 
			(
				'json' => sub 
					{
						my $data = Encode::encode_utf8(shift);
						return JSON->new->utf8->allow_nonref->allow_blessed->convert_blessed->relaxed->decode($data);
					}
			);
			if (exists($map{$type}))
			{
				if (ref($map{$type}) eq 'CODE')
				{
					$data = &{$map{$type}}($data);
				}
			}
			return $data;
		};
		$cfg->{'json'} = {};
		while (my $line = <DATA>)
		{
			chomp $line;
			last if ($line eq '__END__');
			if ($line =~ /^#(\w+)\s*@@\s*(\w+)\s*@\s*(\w+)\s*$/)
			{
				$cfg->{$type}->{$section}->{$name} = &$map($type, $cfg->{$type}->{$section}->{$name}) if (defined($type) && defined($section) && defined($name) && !(ref($cfg->{$type}->{$section}->{$name}) eq 'ARRAY'));
				$type = $1;
				$section = $2;
				$name = $3;
				$cfg->{$type}->{$section}->{$name} = (exists($cfg->{$type}) ? '' : []);
			}
			else
			{
				if (defined($type) && defined($section) && defined($name))
				{
					if (ref($cfg->{$type}->{$section}->{$name}) eq 'ARRAY')
					{
						$line = &$map($type, $line);
						push @{$cfg->{$type}->{$section}->{$name}}, $line if (length($line) > 0);
					}
					else
					{
						$cfg->{$type}->{$section}->{$name} .= $line . "\n";
					}
				}
			}
		}
		$cfg->{$type}->{$section}->{$name} = &$map($type, $cfg->{$type}->{$section}->{$name}) if (defined($type) && defined($section) && defined($name) && !(ref($cfg->{$type}->{$section}->{$name}) eq 'ARRAY'));
	}
	my $this = shift;
	my $domain = shift;
	&_init($domain);
	my $self = bless {}, (ref($this) || $this);
	$self->{'ua'}  = LWP::UserAgent->new('agent' => "JSON::RPC::Client", 'default_headers'=>HTTP::Headers->new('Accept'=>"application/json"), 'ssl_opts'=>{'verify_hostname'=>0}, 'timeout'=>10);
	$self->{'json'} = JSON->new->utf8->allow_nonref->allow_blessed->convert_blessed;
	$self->auth();
	return $self;
}

sub DESTROY
{
	my $self = shift;
}

=head2 cmd
Выполнение запроса JSON-RPC и получение ответа
=cut
sub cmd($;$$)
{
	my $self = shift;
	my $obj = shift;
	my $url = shift;
	$url = $cfg->{'rpc'}->{'address'} . $cfg->{'rpc'}->{'sql'} unless (defined($url));
	my $res;
	if ($url =~ /\?/)
	{
		$res = $self->{'ua'}->get($url);
	}
	else
	{
		my $data = $self->{'json'}->encode($obj);
		$res = $self->{'ua'}->post($url, 'Content_Type'=>"application/json", 'Content'=>$data);
	}
	return unless ($res);
	return "#".$res->status_line if ($res->is_error);
	return {} unless ($res->content);
	my $data = $self->{'json'}->decode($res->decoded_content);
	if (ref($data) eq 'ARRAY')
	{
		return {map {$_->{'id'}=>($_->{'error'} ? $_->{'error'} : $_->{'result'})} @$data};
	}
	else
	{
		return (ref($data->{'error'}) ? $data->{'error'}->{'message'} : $data->{'error'}) if ($data->{'error'});
		return $data->{'result'};
	}
}

=head2 obj
Сформировать тело запроса для JSON-RPC
=cut
sub obj($;$$)
{
	my $self = shift;
	my $method = shift;
	my $params = shift;
	my $id = shift;
	my $auto = (defined($id) ? 0 : 1);
	$id = 1+($self->{'last_id'}||0) if ($auto);
	my $json; tie %$json, 'Tie::IxHash';
	$json->{'jsonrpc'} = $cfg->{'rpc'}->{'version'} if (defined($cfg->{'rpc'}->{'version'}));
	$json->{'method'} = $method;
	$json->{'params'} = $params if (defined($params));
	$json->{'id'} = $id if (defined($id));
	$self->{'last_id'} = $id if ($auto);
	return $json;
}

=head2 init
Инициализация сеанса JSON-RPC
=cut
sub auth
{
	my $self = shift;
	my $tmp = "/tmp/iptvportal-$cfg->{'rpc'}->{'domain'}-session.tmp";
	my $sid;
	if (-e $tmp)
	{
		open TMP, '<', $tmp;
		my $t = <TMP>;
		close TMP;
		if ($t)
		{
			my ($t1,$t2) = split(' ', $t);
			if ((time - $t1) < $cfg->{'rpc'}->{'expire'})
			{
				$sid = $t2;
			}
		}
	}
	unless (defined($sid))
	{
		my $auth = $self->obj('authorize_user', {'username'=>$cfg->{'rpc'}->{'username'}, 'password'=>$cfg->{'rpc'}->{'password'}});
		my $url = $cfg->{'rpc'}->{'address'} . $cfg->{'rpc'}->{'api'};
		my $res = $self->cmd($auth, $url);
		return undef unless (ref($res) eq 'HASH');
		$sid = $res->{'session_id'};
		open TMP, '>', $tmp;
		print TMP time . " " . $sid;
		close TMP;
	}
	$self->{'sid'} = $sid;
	$self->{'ua'}->default_header('Iptvportal-Authorization' => "sessionid=$sid");
	return $sid;
}

=head2 retrieve
Получить списки основных объектов БД.
=cut
sub retrieve
{
	my $self = shift;
	my @list = @_;
	my $fldmap = {};
	my $batch = [];
	foreach my $item (@list)
	{
		if (exists($cfg->{'json'}->{'list'}->{$item}))
		{
			my $obj = $self->obj('select', $cfg->{'json'}->{'list'}->{$item}, $item);
			$fldmap->{$item} = $obj->{'params'}->{'data'};
			push @$batch, $obj;
		}
	}
	my $ret = $self->cmd($batch);
	my $res = {};
	foreach my $item (keys(%$ret))
	{
		my $rows = $ret->{$item};
		return undef unless ($rows && ref($rows) eq 'ARRAY');
		my $fld = $fldmap->{$item};
		$res->{$item} = undef;
		if ($item ~~ [qw(domain)])
		{
			$rows = $rows->[0];
			$res->{$item} = {'id'=>$rows->[0], 'name'=>$rows->[1]};
			next;
		}
		$res->{$item} = [];
		foreach my $row (@$rows)
		{
			push @{$res->{$item}}, {map {$fld->[$_]=>$row->[$_]} (0..$#{$fld})};
		}
	}
	return $res;
}


1;


__DATA__

#json @@ list @ domain
{
"data": ["id", "name"],
"from": "domain",
}

#json @@ list @ playlist
{
"data": ["id", "name", "title"],
"from": "playlist",
"where": {"eq": ["is_tv", true]},
}

#json @@ list @ package
{
"data": ["id", "name", "paid"],
"from": "package",
}

#json @@ list @ profile
{
"data": ["id", "name"],
"from": "profile",
}

#json @@ list @ sprofile
{
"data": ["id", "name"],
"from": "sprofile",
}

#json @@ list @ pprofile
{
"data": ["id", "name"],
"from": "pprofile",
}

#json @@ list @ media
{
"data": ["id", "index", "name", "protocol","inet_addr","port", "disabled", "channel_id", "encrypted", "key_id", "is_tv"],
"from": "media",
}

#json @@ list @ playlist_media
{
"data": ["media_id", "playlist_id", "index", "disabled"],
"from": "playlist_media",
}

#json @@ list @ package_media
{
"data": ["media_id", "package_id", "disabled"],
"from": "package_media",
}

#json @@ list @ subscriber
{
"data": ["id", "username", "password", "max_terminal", "sprofile_id", "language_id", "first_name", "middle_name", "surname", "email", "address", "phone", "disabled", "comment"],
"from": "subscriber",
}

#json @@ list @ subscriber_package
{
"data": ["subscriber_id", "package_id", "enabled"],
"from": "subscriber_package",
}

#json @@ list @ subscriber_media
{
"data": ["subscriber_id", "media_id", "enabled"],
"from": "subscriber_media",
}

#json @@ list @ profile_media
{
"data": ["domain_id", "media_id", "profile_id", "disabled"],
"from": "profile_media",
}

#json @@ list @ sprofile_media
{
"data": ["media_id", "sprofile_id", "disabled"],
"from": "sprofile_media",
}

#json @@ list @ pprofile_media
{
"data": ["media_id", "pprofile_id", "disabled"],
"from": "pprofile_media",
}


__END__




Использовать примерно так:
Код: 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.
...
use IPTVPortal;
...
my $tv = IPTVPortal->new();
...
$log->run("# Загрузка данных с IPTV-портала");
my $cache = $tv->retrieve(qw(subscriber package subscriber_package media subscriber_media));
my $key = {};
my $idx = {};
unless ($cache)
{
	$log->err("! Ошибка загрузки данных с IPTV-портала");
	exit 1;
}

$log->log("- индексация клиентов");
$key->{'client'} = {map {$_->{'username'} => $_->{'id'}} @{$cache->{'subscriber'}}};
$idx->{'client'} = {map {$_->{'id'} => $_->{'username'}} @{$cache->{'subscriber'}}};

$log->log("- индексация пакетов");
$idx->{'package'} = {map {$_->{'id'} => $_->{'name'}} @{$cache->{'package'}}};
{
	$key->{'package'} = &json('config', 'Packages');
	$key->{'package'}->{$_->{'name'}}->{'id'} = $_->{'id'} foreach (grep {exists($key->{'package'}->{$_->{'name'}})} @{$cache->{'package'}});
	delete $key->{'package'}->{$_} foreach (grep {!exists($key->{'package'}->{$_}->{'id'})} (keys %{$key->{'package'}}));
}

$log->log("- обработка подписок на пакеты");
{
	my $lst = {};
	$lst->{$_->{'subscriber_id'}}->{$_->{'package_id'}} = $_->{'enabled'} foreach (@{$cache->{'subscriber_package'}});
	$cache->{'subscriber_package'} = $lst;
}

$log->log("- индексация каналов");
$idx->{'channel'} = {map {$_->{'id'} => ($_->{'name'} =~ m/^(CAM-[-0-9]+)/)} grep {$_->{'name'} =~ m/^(CAM-[-0-9]+)/} @{$cache->{'media'}}};
$key->{'channel'} = {map {$idx->{'channel'}->{$_} => $_} keys(%{$idx->{'channel'}})};

$log->log("- обработка подписок на каналы");
{
	my $lst = {};
	$lst->{$_->{'subscriber_id'}}->{$_->{'media_id'}} = $_->{'enabled'} foreach (@{$cache->{'subscriber_media'}});
	$cache->{'subscriber_media'} = $lst;
}

...




Код: 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.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
$log->run("# Формирование пакетного задания");
my $batch = {'insert'=>[], 'delete'=>[], 'update'=>[], 'packages'=>[], 'channels'=>[]};
my $cnt = {'all'=>0, 'ena'=>0, 'dis'=>0, 'ins'=>0, 'del'=>0, 'upd'=>0};
$key->{'package'}->{$_}->{'count'} = {} foreach (keys(%{$key->{'package'}}));
foreach my $sub (@{$cache->{'subscriber'}})
{
	my $id = $sub->{'id'};
	my $login = $sub->{'username'};
	next if ($login =~ /^!/);
	unless (exists($list->{$login}))
	{
		$log->act("- $login - удален");
		push @{$batch->{'delete'}}, $id;
		$cnt->{'del'}++;
		next;
	}
	$cnt->{'all'}++;
	my $usr = $list->{$login};
	delete $list->{$login};
	my $update = {};
	if ($sub->{'password'} ne lc(md5_hex($usr->{'PASSWORD'}||'')))
	{
		$update->{'password'} = {'value'=>lc(md5_hex($usr->{'PASSWORD'}||'')), 'label'=>"пароль"};
	}
	if ($sub->{'surname'} ne $usr->{'TARIFF'})
	{
		$update->{'surname'} = {'value'=>$usr->{'TARIFF'}, 'label'=>"тариф"};
	}
	if (($sub->{'max_terminal'}||0) != ($usr->{'TERMINALS'}||0))
	{
		$update->{'max_terminal'} = {'value'=>$usr->{'TERMINALS'}, 'label'=>"терминалы"};
	}
	if (($sub->{'disabled'} ? 0 : 1) != ($usr->{'STATE'} ? 1 : 0))
	{
		$update->{'disabled'} = {'value'=>($usr->{'STATE'} ? undef : true), 'label'=>"статус"};
		$cnt->{($usr->{'STATE'} ? "ena" : "dis")}++;
	}
	$key->{'package'}->{$_}->{'count'}->{$login} = $usr->{'STATE'} foreach (keys %{$usr->{'_PACKAGE'}});
	$usr->{'_PACKAGE_LIST'} = [sort map {$key->{'package'}->{$_}->{'id'}} grep {exists($key->{'package'}->{$_}) && exists($key->{'package'}->{$_}->{'id'})} (keys %{$usr->{'_PACKAGE'}})];
	$usr->{'_CHANNEL_LIST'} = [sort map {$key->{'channel'}->{$_}} grep {exists($key->{'channel'}->{$_})} (keys %{$usr->{'_CHANNEL'}})];
	my @pa = sort grep {$cache->{'subscriber_package'}->{$id}->{$_}} (keys %{$cache->{'subscriber_package'}->{$id}});
	if (!(\@pa ~~ $usr->{'_PACKAGE_LIST'}))
	{
		$update->{'tariff'} = {'label'=>"пакеты"};
		push @{$batch->{'packages'}}, {'key'=>$login, 'list'=>$usr->{'_PACKAGE_LIST'}};
	}
	my @ca = sort grep {$cache->{'subscriber_media'}->{$id}->{$_}} (keys %{$cache->{'subscriber_media'}->{$id}});
	if (!(\@ca ~~ $usr->{'_CHANNEL_LIST'}))
	{
		$update->{'channel'} = {'label'=>"каналы"};
		push @{$batch->{'channels'}}, {'key'=>$login, 'list'=>$usr->{'_CHANNEL_LIST'}};
	}
	if (%$update)
	{
		$update->{'comment'} = {'value'=>"Обновлено: " . $log->_timestamp()};
		$log->act("- $login - обновлен (" . join(', ', grep {defined($_)} map {$_->{'label'}} values(%$update)) . ")");
		delete $update->{$_} foreach grep {!exists($update->{$_}->{'value'})} (keys %$update);
		push @{$batch->{'update'}}, {'id'=>$id, 'update'=>$update};
		$cnt->{'upd'}++;
	}
}
foreach my $usr (values(%$list))
{
	my $login = $usr->{'USERNAME'} ;
	$log->act("- $login - добавлен" . ($usr->{'STATE'} ? " (активный)" : " (неактивный)"));
	my $update = {'username'=>$login};
	$update->{'password'} = lc(md5_hex($usr->{'PASSWORD'}||''));
	$update->{'surname'} = $usr->{'TARIFF'};
	$update->{'max_terminal'} = $usr->{'TERMINALS'};
	$update->{'disabled'} = ($usr->{'STATE'} ? undef : true);
	$update->{'comment'} = "Добавлено: " . $log->_timestamp();
	$cnt->{'all'}++;
	$cnt->{'ins'}++;
	$cnt->{($usr->{'STATE'} ? "ena" : "dis")}++;
	$key->{'package'}->{$_}->{'count'}->{$login} = $usr->{'STATE'} foreach (keys %{$usr->{'_PACKAGE'}});
	$usr->{'_PACKAGE_LIST'} = [sort map {$key->{'package'}->{$_}->{'id'}} grep {exists($key->{'package'}->{$_}) && exists($key->{'package'}->{$_}->{'id'})} (keys %{$usr->{'_PACKAGE'}})];
	$usr->{'_CHANNEL_LIST'} = [sort map {$key->{'channel'}->{$_}} grep {exists($key->{'channel'}->{$_})} (keys %{$usr->{'_CHANNEL'}})];
	push @{$batch->{'insert'}}, $update;
	push @{$batch->{'packages'}}, {'key'=>$login, 'list'=>$usr->{'_PACKAGE_LIST'}} if (@{$usr->{'_PACKAGE_LIST'}});
	push @{$batch->{'channels'}}, {'key'=>$login, 'list'=>$usr->{'_CHANNEL_LIST'}} if (@{$usr->{'_CHANNEL_LIST'}});
}

$log->run("# Выполнение пакетного задания...");
{
	my $job = [];
	my $qs = ($meta->{'config'}->{'batch'}||1);
	if (@{$batch->{'delete'}})
	{
		$log->print("- Удаление - " . scalar(@{$batch->{'delete'}}) . "...");
		while (my @batch = splice(@{$batch->{'delete'}}, 0, $qs))
		{
			my $req = &json('batch','delete');
			$req->{'where'}->{'in'} = [@{$req->{'where'}->{'in'}}, @batch];
			my $cmd = $tv->obj('delete', $req);
			push @$job, $cmd;
		}
	}
	my $new = {};
	if (@{$batch->{'insert'}})
	{
		$log->print("- Добавление - " . scalar(@{$batch->{'insert'}}) . "...");
		my $i = 0;
		while (my @batch = splice(@{$batch->{'insert'}}, 0, $qs))
		{
			my $req = &json('batch','insert');
			foreach my $insert (@batch)
			{
				push @{$req->{'values'}}, [map {$insert->{$_}} @{$req->{'columns'}}];
			}
			my $cmd = $tv->obj('insert', $req, "new#$i");
			push @$job, $cmd;
			$new->{"new#$i"} = [map {$_->{'username'}} @batch];
			$i += scalar(@batch);
		}
	}
	if (@{$batch->{'update'}})
	{
		$log->print("- Обновление - " . scalar(@{$batch->{'update'}}) . "...");
		while (my @batch = splice(@{$batch->{'update'}}, 0, $qs))
		{
			foreach my $update (@batch)
			{
				my $req = &json('batch','update');
				push @{$req->{'where'}->{'eq'}}, $update->{'id'};
				$req->{'set'} = {map {$_=>$update->{'update'}->{$_}->{'value'}}keys(%{$update->{'update'}})};
				my $cmd = $tv->obj('update', $req);
				push @$job, $cmd;
			}
		}
	}
	my $res;
	if ($job && @$job)
	{
		$res = $tv->cmd($job);
		foreach my $label (keys(%$new))
		{
			my @rows = $res->{$label};
			my @user = @{$new->{$label}};
			foreach my $i (0..$#rows)
			{
				$key->{'client'}->{$user[$i]} = $rows[$i];
				$idx->{'client'}->{$rows[$i]} = $user[$i];
			}
		}
		$job = undef;
		$res = undef;
	}
	if (@{$batch->{'packages'}})
	{
		$log->print("- Обновление пакетов - " . scalar(@{$batch->{'packages'}}) . "...");
		$job = [];
		while (my @batch = splice(@{$batch->{'packages'}}, 0, $qs))
		{
			foreach my $item (@batch)
			{
				my $lst = $item->{'list'};
				my $id = $key->{'client'}->{$item->{'key'}} || next;
				my $req = &json('batch','package_clean');
				push @{$req->{'where'}->{'eq'}}, $id;
				push @$job, $tv->obj('delete', $req);
				if (@$lst)
				{
					$req = &json('batch','package_insert');
					push @{$req->{'values'}}, map {[$id, $_, true]} @$lst;
					push @$job, $tv->obj('insert', $req);
				}
			}
		}
		$res = $tv->cmd($job) if (@$job);
		$job = undef;
		$res = undef;
	}
	if (@{$batch->{'channels'}})
	{
		$log->print("- Обновление каналов - " . scalar(@{$batch->{'channels'}}) . "...");
		$job = [];
		while (my @batch = splice(@{$batch->{'channels'}}, 0, $qs))
		{
			foreach my $item (@batch)
			{
				my $lst = $item->{'list'};
				my $id = $key->{'client'}->{$item->{'key'}} || next;
				my $req = &json('batch','channel_clean');
				push @{$req->{'where'}->{'eq'}}, $id;
				push @$job, $tv->obj('delete', $req);
				if (@$lst)
				{
					$req = &json('batch','channel_insert');
					push @{$req->{'values'}}, map {[$id, $_, true]} @$lst;
					push @$job, $tv->obj('insert', $req);
				}
			}
		}
		$res = $tv->cmd($job) if (@$job);
		$job = undef;
		$res = undef;
	}
}




Под вторым спойлером фрагмент, в соответствии с которым я бы рекомендовал использовать класс.
При такой схеме обработка выполняется очень быстро (пять сотен абонентов синхронизируются несколько секунд).
Ну или доработать класс и способ его использованися под свои потребности.
...
Рейтинг: 0 / 0
08.08.2016, 16:40
    #39288444
alexeypp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Спасибо, Alibek B.
Это заметно выше моего владения PERLом, но думаю получится разобраться.
...
Рейтинг: 0 / 0
08.08.2016, 17:55
    #39288506
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
В минимуме все очень просто сохранить JSON-запрос в переменной (или в массив) и вызвать метод cmd() из модуля IPTVPortal.
...
Рейтинг: 0 / 0
10.08.2016, 11:10
    #39289494
alexeypp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Не растет кокос :(

package скопипастил и прикрутил, внеся собственные параметры в Домен, Логин и Пароль.
Теперь пытаюсь его использовать, для начала загрузить данные с портала.

Код: plsql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
use IPTVPortal;
my $tv = IPTVPortal->new();
my $cache = $tv->retrieve(qw(subscriber));
my $key = {};
my $idx = {};
unless ($cache)
{
        $log->err("!IPTV-ERR");
        exit 1;
}




получаю

Код: pascal
1.
2.
3.
Can't use string ("#500 Can't connect to admin.inte"...) as a HASH ref while "st
rict refs" in use at /usr/local/lib/perl5/site_perl/5.14.2/mach/IPTVPortal.pm li
ne 232, <DATA> line 94.



232 это строка
foreach my $item (keys(%$ret))
в sub retrieve


Alibek, ваша почта, указанная в заголовке package актуальна?
Если у вас есть возможность и желание, я бы поконсультировался по теме этого взаимодействия с IPTVпорталом подробнее и оперативнее. Не безвозмездно, разумеется.
...
Рейтинг: 0 / 0
10.08.2016, 19:43
    #39289991
volodin661
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
alexeypppackage скопипастил и прикрутил, внеся собственные параметры в Домен, Логин и Пароль.

получаю "#500 Can't connect to admin.inte"...


может для начала проверить параметры Домен, Логин и Пароль ?
...
Рейтинг: 0 / 0
10.08.2016, 22:43
    #39290047
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
В функции retrieve используется метод cmd.
Метод cmd возвращает хэш с результатами в случае успешного выполнения запроса и скаляр в случае неуспешного выполнения (текст ошибки).
В retrieve проверка результата вызова cmd не осуществляется, но по тексту в консоли видно, что сервер ответил ошибкой 500.
Было бы неплохо полностью прочитать текст ошибки (вывести дамп $ret), там либо ошибка авторизации (значит логин/пароль/домен неверные), либо некорректный JSON-запрос. JSON-запрос прошит в коде модуля, у меня работает нормально, возможно что у вас используется старая версия Middleware, в которой отсутствуют какие-либо поля.

Также можно вставить отладочный Dump в метод cmd, чтобы видеть, что фактически отправляется и принимается.
...
Рейтинг: 0 / 0
10.08.2016, 23:30
    #39290052
alexeypp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
На всякий случай скопипастил все еще раз и вписал/перепроверил домен логин пароль.

Вписал в package
Код: sql
1.
print $ret;


получил
#500 Can't connect to admin.МойДомен.iptvportal.ru:443 (certificate verify failed)

Но перенес все на другой сервер2 и оттуда все вроде бы заработало, сейчас во всяком случае session_id удалось получить и он прописался в tmp файлик.

С ошибкой сертификата какая-то общая проблема на сервере1. Сегодня по JSON многие примеры порешал, разнообразно пытаясь до IPTVпортала достучаться - никак не обходится certificate verify failed. Несколько решений из Интернетов применял - всеравно не обходится. Модули PERLа обновил.
Может еще есть какие-нибудь идеи как обойти ошибку проверки сертификата? Мне взаимодействие с IPTVпорталом надо на сервер1 запускать.


На сервере2 же лишь пишет сообщение/предупреждение
Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
*******************************************************************
 Using the default of SSL_verify_mode of SSL_VERIFY_NONE for client
 is deprecated! Please set SSL_verify_mode to SSL_VERIFY_PEER
 together with SSL_ca_file|SSL_ca_path for verification.
 If you really don't want to verify the certificate and keep the
 connection open to Man-In-The-Middle attacks please set
 SSL_verify_mode explicitly to SSL_VERIFY_NONE in your application.
*******************************************************************
  at /usr/local/lib/perl5/site_perl/5.14.2/LWP/Protocol/http.pm line 27


но работает.
...
Рейтинг: 0 / 0
11.08.2016, 08:16
    #39290092
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
А какая версия Perl и модуля LWP?
...
Рейтинг: 0 / 0
11.08.2016, 10:16
    #39290157
alexeypp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
СЕРВЕР1
# uname -a
FreeBSD 8.3-RELEASE FreeBSD 8.3-RELEASE #0: Thu Feb 14 i386

# perl -V
Summary of my perl5 (revision 5 version 14 subversion 2)
Built under freebsd
Compiled at Feb 14 2013 10:51:01
@INC:
/usr/local/lib/perl5/5.14.2/BSDPAN
/usr/local/lib/perl5/site_perl/5.14.2/mach
/usr/local/lib/perl5/site_perl/5.14.2
/usr/local/lib/perl5/5.14.2/mach
/usr/local/lib/perl5/5.14.2

cpan[2]> install LWP
LWP is up to date (6.15).


На сервере1 и сервере2 версии Perl и LWP одинаковые.
Разница лишь в том, что сервер2 FreeBSD 9.1-RELEASE FreeBSD 9.1-RELEASE i386
В начале плясок вокруг JSON сервер1 тоже показывал не certificate verify failed а предупреждение ...explicitly to SSL_VERIFY_NONE in your application (как сейчас сервер2), но видимо после доустановки, обновления всех модулей и перезагрузки впал в нынешнее состояние когда на него не действует 'ssl_opts'=>{'verify_hostname'=>0
...
Рейтинг: 0 / 0
11.08.2016, 14:18
    #39290335
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
У меня версия LWP 6.13 и все работает нормально.
Видимо в новой версии этого недостаточно.
Можно попробовать указать:
'ssl_opts'=>{'verify_hostname'=>0, SSL_verify_mode => SSL_VERIFY_NONE}
...
Рейтинг: 0 / 0
11.08.2016, 16:32
    #39290475
alexeypp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Bareword "SSL_VERIFY_NONE" not allowed while "strict subs" in use at /usr/local/
lib/perl5/site_perl/5.14.2/mach/IPTVPortal.pm line 119.
Compilation failed in require....
BEGIN failed--compilation aborted....

Думаю что дело не в LWP т.к. на сервер2 она такой же версии. Буду искать...
...
Рейтинг: 0 / 0
12.08.2016, 10:00
    #39290776
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
alexeyppBareword "SSL_VERIFY_NONE" not allowed while "strict subs"
Ну да, нужно указать префикс класса.
Или посмотреть значение константы SSL_VERIFY_NONE (скорее всего будет 0) и использовать число.
...
Рейтинг: 0 / 0
02.09.2016, 16:47
    #39302841
alexeypp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
Запрос существующих имен клиентов возвращает и выводит следующее (id и username)

Код: sql
1.
2.
3.
4.
5.
6.
$VAR1 = {
          'client' => {
                        '1' => 111,
                        '2' => 222
                      }
        };



Как полученное загрузить в некий двумерный массив?
Чтобы получилось следующая структура

Код: sql
1.
2.
3.
4.
my      @arr = (
                        [1, 111],
                        [2, 222]
        );



И можно было работать с этим например так

Код: sql
1.
print $arr[1][1];       # 222
...
Рейтинг: 0 / 0
03.09.2016, 14:31
    #39303132
volodin661
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
alexeypp,

боюсь, ты не получишь желаемого,
потому что данные лежат в хэше беспорядочно,
а массив предполагает упорядоченное хранение,
но технически это может выглядеть так:

Код: perl
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
my $y=[];    # ссылка на целевой массив анонимных массивов 

my $x = {    # ссылка на исходный хэш

    client  => {
                 a=>1,
                 b=>2
               },
    server  => {
                 c=>6,
                 d=>5
               }
};

while( my ($key,$val)= each %$x ) {
    while ( my @pair = each %$val) { 
        push @$y, [@pair];
    }
} 
use Data::Dump;
dd $y;


output:
[["d", 5], ["c", 6], ["b", 2], ["a", 1]]
...
Рейтинг: 0 / 0
04.09.2016, 16:41
    #39303390
Alibek B
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru)
alexeyppКак полученное загрузить в некий двумерный массив?
Метод retrieve возвращает данные в виде определенной структуры.
Можно по аналогии с ним сделать метод, возвращающий массив массивов.

volodin661потому что данные лежат в хэше беспорядочно,
Также можно использовать Tie::IxHash.
...
Рейтинг: 0 / 0
Форумы / PHP, Perl, Python [игнор отключен] [закрыт для гостей] / Вопрос по использованию JSON-RPC на Perl (на iptvportal.ru) / 21 сообщений из 21, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]