package IIfe7ed66bde3aa68899b7883eab4be165::mod_Interspire; use strict; use base 'JinPluginBaseExtScript'; use HTTP::Request; use LWP::UserAgent; sub init { my $this = shift()->SUPER::init(@_); return $this->msg('error.missing_config') if grep { ! $this->{$_} } qw/Path Username Token/; return; } sub addUser { my $this = shift; my $user = shift; my $path = _text2xml($this->{Path}); my $username = _text2xml($this->{Username}); my $token = _text2xml($this->{Token}); my $mailingList = _text2xml($this->_get_list_id); my $email = _text2xml($user->{email}); my $xml_req = qq( <xmlrequest> <username>$username</username> <usertoken>$token</usertoken> <requesttype>subscribers</requesttype> <requestmethod>AddSubscriberToList</requestmethod> <details> <emailaddress>$email</emailaddress> <mailinglist>$mailingList</mailinglist> <format>html</format> <confirmed>yes</confirmed> </details> </xmlrequest> ); my $http_req = HTTP::Request->new; $http_req->method('POST'); $http_req->uri($path); $http_req->header('content-type', 'text/xml'); $http_req->content($xml_req); my $ua = LWP::UserAgent->new; $ua->timeout(10); $ua->env_proxy; $ua->request($http_req); return; } sub updateUser { my $this = shift; my $user = shift; if ($user->{old_email}) { $this->deleteUser($user); $this->addUser($user); return; } return; } sub deleteUser { my $this = shift; my $user = shift; my $path = _text2xml($this->{Path}); my $username = _text2xml($this->{Username}); my $token = _text2xml($this->{Token}); my $mailingList = _text2xml($this->_get_list_id); my $email = _text2xml($user->{old_email} || $user->{email}); my $xml_req = qq( <xmlrequest> <username>$username</username> <usertoken>$token</usertoken> <requesttype>subscribers</requesttype> <requestmethod>DeleteSubscriber</requestmethod> <details> <emailaddress>$email</emailaddress> <list>$mailingList</list> </details> </xmlrequest> ); my $http_req = HTTP::Request->new; $http_req->method('POST'); $http_req->uri($path); $http_req->header('content-type', 'text/xml'); $http_req->content($xml_req); my $ua = LWP::UserAgent->new; $ua->timeout(10); $ua->env_proxy; $ua->request($http_req); return; } sub suspendUser { my $this = shift; my $user = shift; $this->deleteUser($user); return; } sub getUsernameForUser { my $this = shift; my $user = shift; $user->{email}; } sub _get_list_id { my $this = shift; my $path = _text2xml($this->{Path}); my $username = _text2xml($this->{Username}); my $token = _text2xml($this->{Token}); my $xml_req = qq( <xmlrequest> <username>$username</username> <usertoken>$token</usertoken> <requesttype>user</requesttype> <requestmethod>GetLists</requestmethod> <details> </details> </xmlrequest> ); my $http_req = HTTP::Request->new; $http_req->method('POST'); $http_req->uri($path); $http_req->header('content-type', 'text/xml'); $http_req->content($xml_req); my $ua = LWP::UserAgent->new; $ua->timeout(10); $ua->env_proxy; my $response = $ua->request($http_req); my $content = $response->content; my $pos = index($content, "<name>$this->{MailingList}</name>"); my $from = rindex($content, '<listid>', $pos) + length('<listid>'); my $to = index($content, '</listid>', $from); substr($content, $from, $to - $from) + 0; } sub _text2xml { my $v = shift; $v =~ s/&/&amp;/g; $v =~ s/"/&quot;/g; $v =~ s/>/&gt;/g; $v =~ s/</&lt;/g; $v =~ s/'/&apos;/g; $v; } 1; 