I have a Perl script that is successfully getting a response from my ShoreTel Phone server. The server provides information on what calls are currently connected for the extension entered. However I am having issues looping through the sub arrays to get more than one response when there are multiple items. In this case I want to get each of the caller IDs that is currently connected.
My SOAP:LITE request is successfully pulling data from the server using the following code:
use strict;
use warnings;
use SOAP::Lite;
use CGI;
use Data::Dumper;
my $myWebService = SOAP::Lite
-> uri('http://www.ShoreTel.com/ProServices/SDK/Web')
-> proxy('http://10.1.##.##:8070/ShoreTelWebSDK/WebService')
-> on_action(sub {sprintf '%s/ShoreTelWebService/%s', $_[0], $_[1]});
my $query = new CGI;
my $ip = $query->remote_host; # IP address of remote party...use later as unique identifier
my $myClientID = $query->param('MyClientID'); # Possible client ID from previous script passed into us.
my $extnNr = $query->param('MyExtn'); # Has to be at least an extension number so we know who to status.
my $url = CGI::url(-path_info=>1); # What is my URL?
# There should be an extension number given, else what would we status.
if (defined($refreshNr) && defined($extnNr) && ($extnNr ne '') && ($refreshNr ne ''))
{
# If there is a client ID defined, use it...otherwise registering and getting a client ID
# is the first thing we need to do when using our web service.
unless (defined($myClientID))
{
# To use our service, we need to register ourselves as a client...use remote IP address
# as a unique name for association to this session.
my $regClientResult = $myWebService->RegisterClient(SOAP::Data->name('clientName' => $ip));
if ($regClientResult->fault)
{
print '<p>FAULT', $myClientID->faultcode, ', ', $myClientID->faultstring;
}
else
{
# Retrieve client ID which we will be using for subsequent communication.
$myClientID = $regClientResult->valueof('//RegisterClientResponse/RegisterClientResult/');
}
}
if (defined($myClientID))
{
# Use our web service to open the line. This is necessary to get a line ID.
# print '<br>Client ID ', $myClientID, ' has been registered.<br>';
my $openResult = $myWebService->OpenLine(SOAP::Data->name('clientHandle' => $myClientID), SOAP::Data->name('lineAddress' => $extnNr));
my $lineID = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineID/');
my $lineType = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineType/');
my $lineName = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineName/');
my $lineState = $openResult->valueof('//OpenLineResponse/OpenLineResult/lineState/');
# Call GetActiveCalls to see if anything is going on with this line.
my $result = $myWebService->GetActiveCalls(SOAP::Data->name('clientHandle' => $myClientID), SOAP::Data->name('lineID' => $lineID));
my $callID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callID/');
if ($callID ne '')
{
# print '<br>Call ID is ', $callID;
my $isExternal = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/isExternal/');
my $isInbound = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/isInbound/');
my $callReason = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callReason/');
my $connectedID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/connectedID/');
my $connectedIDName = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/connectedIDName/');
my $callerID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');
my $callerIDName = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerIDName/');
my $calledID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/calledID/');
my $calledIDName = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/calledIDName/');
my $callState = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callState/');
my $callStateDetail = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callStateDetail/');
# Print call information.
print <<EndOfCallInfo;
HTML CODE
EndOfCallInfo
}
else
{
print <<EndOfCallInfo2;
HTML CODE
EndOfCallInfo2
}
}
}
But I am only able to access the first result in the multidimensional array.
I have tried looping through the results using
for my $t ($result->result({ShoreTelCallStateInfo}{callInfo}')) {
print $t->{callerID} . "\n";}
But I am getting absolutely no results. It appears that the the loop is not even entered.
The following code I have works fine, but only pulls the first caller ID, in this case 1955.
my $callerID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');
What can I do to make my loop work?
So that you can see what I am receiving from the server I have included the response from the SOAP Server using DUMP :
$VAR1 = { 'ShoreTelCallStateInfo' => [
{ 'callStateDetail' => 'Active',
'callState' => 'OnHold',
'callInfo' =>
{ 'callerIDName' => 'Joel LASTNAME',
'callID' => '69105', 'lineID' => '3947',
'connectedIDName' => 'VM-Forward',
'calledID' => '2105',
'callerID' => '1955',
'isInbound' => 'false',
'calledIDName' => 'VM-Forward',
'callReason' => 'None',
'callUniqueID' => '1369702515',
'connectedID' => '2105',
'isExternal' => 'false',
'callGUID' => '{00030000-66C2-537E-3FD8-0010492377D9}'
}
},
{ 'callStateDetail' => 'Active',
'callState' => 'Connected',
'callInfo' =>
{ 'callerIDName' => 'LASTNAME Joel ',
'callID' => '71649',
'lineID' => '3947',
'connectedIDName' => 'LASTNAME Joel ',
'calledID' => '1955',
'callerID' => '+1385#######',
'isInbound' => 'true',
'calledIDName' => 'Joel LASTNAME',
'callReason' => 'None',
'callUniqueID' => '1117287558',
'connectedID' => '+1385#######',
'isExternal' => 'true',
'callGUID' => '{00030000-66C5-537E-3FD8-0010492377D9}'
}
}
]
};
Just a guess...
The following code I have works fine, but only pulls the first caller
ID, in this case 1955.
my $callerID = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');
What can I do to make my loop work?
SOAP::Lite docs say:
valueof()
Returns the value of a (previously) matched node. It accepts a node
path. In this case, it returns the value of matched node, but does not
change the current node. Suitable when you want to match a node and
then navigate through node children:
$som->match('/Envelope/Body/[1]'); # match method
$som->valueof('[1]'); # result
$som->valueof('[2]'); # first out parameter (if present)
The returned value depends on the context. In a scalar context it will
return the first element from matched nodeset. In an array context it
will return all matched elements.
Does this give the behavior you expect? It imposes list context on the valueof method.
for my $callerID ($result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/')) {
...
# do something with each callerID
}
or
my #callerIDs = $result->valueof('//GetActiveCallsResponse/GetActiveCallsResult/ShoreTelCallStateInfo/callInfo/callerID/');
Related
I am sending email using Dancer2 via the Dancer2::Plugin::Email package. The main code that I have for this is:
sub sendEmail {
my ($params,$email_address,$template) = #_;
my $text = '';
my $tt = Template->new({
INCLUDE_PATH => config->{views},
INTERPOLATE => 1,
OUTPUT => \$text
}) || die "$Template::ERROR\n";
my $out = $tt->process($template,$params);
my $email = email {
from => XXXXX,
to => $email_address,
subject => XXXXX,
body => $text,
'Content-Type' => 'text/html'
};
}
where I have hidden a couple of the fields. I have gotten the following error:
Route exception: open body: Invalid argument at
/usr/local/share/perl/5.22.1/MIME/Entity.pm line 1878. in
/usr/local/share/perl/5.22.1/Dancer2/Core/App.pm l. 1454
It is not occurring all of the time and I haven't been able to find a consistent piece of code that always fails.
I have set the host parameter of the mail server that I am using in the configuration as explained here: https://metacpan.org/pod/Dancer2::Plugin::Email Simple tests show it works, but I get sporadic errors that I can't track down.
I have the following code:
$r->find('user')->via('post')->over(authenticated => 1);
Given that route I can get to the user route passing through the authenticated check
that is setup using Mojolicious::Plugin::Authentication.
I want add another 'over' to that route.
$r->find('user')->via('post')->over(authenticated => 1)->over(access => 1);
That appears to override authenticated 'over' though.
I tried breaking up the routes with names like:
my $auth = $r->route('/')->over(authenticated => 1)
->name('Authenticated Route');
$access = $auth->route('/user')->over(access => 1)->name('USER_ACCESS');
That didn't work at all though. Neither of the 'over's are being accessed.
My routes are things like /user, /item, set up using MojoX::JSON::RPC::Service.
So, I don't have things like /user/:id to set up sub routes.( not sure that matters )
All routes are like /user, sent with parameters.
I've got a condition like:
$r->add_condition(
access => sub {
# do some stuff
},
);
that is the 'access' in $r->route('/user')->over(access => 1);
In short, the routes work fine when using:
$r->find('user')->via('post')->over(authenticated => 1);
But I'm unable to add a 2nd route.
So, what am I missing in setting up these routes with multiple conditions?
Is it possible to add multiple conditions to a single route /route_name?
You can just use both conditions in over like in this test:
use Mojolicious::Lite;
# dummy conditions storing their name and argument in the stash
for my $name (qw(foo bar)) {
app->routes->add_condition($name => sub {
my ($route, $controller, $to, #args) = #_;
$controller->stash($name => $args[0]);
});
}
# simple foo and bar dump action
sub dump {
my $self = shift;
$self->render_text(join ' ' => map {$self->stash($_)} qw(foo bar));
}
# traditional route with multiple 'over'
app->routes->get('/frst')->over(foo => 'yo', bar => 'works')->to(cb => \&dump);
# lite route with multiple 'over'
get '/scnd' => (foo => 'hey', bar => 'cool') => \&dump;
# test the lite app above
use Test::More tests => 4;
use Test::Mojo;
my $t = Test::Mojo->new;
# test first route
$t->get_ok('/frst')->content_is('yo works');
$t->get_ok('/scnd')->content_is('hey cool');
__END__
1..4
ok 1 - get /frst
ok 2 - exact match for content
ok 3 - get /scnd
ok 4 - exact match for content
Works fine here with Mojolicious 3.38 on perl 5.12.1 - #DavidO is right, maybe bridges can do the job better. :)
In my case I use two under methods:
$r = $app->routes;
$guest = $r->under->to( 'auth#check_level' );
$user = $r->under->to( 'auth#check_level', { required_level => 100 } );
$admin = $r->under->to( 'auth#check_level', { required_level => 200 } );
$guest->get( '/' )->to( 'main#index' );
$user->get( '/user' )->to( 'user#show' );
$super_admin = $admin->under->to( 'manage#check_level', { super_admin => 100 } );
$super_admin->get( '/delete_everything' )->to( 'system#shutdown' );
In this example when any of routes match some under will be called
'/' -> auth#check_level -> main_index
'/user' -> auth#check_level { required_level => 100 } -> 'user#show'
'/delete_everything' -> auth#check_level { required_level => 200 } -> 'manage#check_level', { super_admin => 100 } -> 'system#shutdown'
As you can see before target action in your controller will be run another action called: auth#check_level and manage#check_level
In each those extra actions you just compare stash->{ required_level } with session->{ required_level } you have set when authorize user
package YourApp::Controller::Manage;
sub check_level {
my $self = shift;
my $user_have = $self->session->{ required_level };
my $we_require = $self->stash->{ required_level };
# 'system#shutdown' will be called if user has required level
return 1 if $user_have >= $we_require;
$self->redirect_to( '/you_have_no_access_rights' );
return 0; #This route will not match. 'system#shutdown' will not be called
}
PS Of course I may use cb or just CODEREF which are "close same" to controller action:
$r->under({ cb => \&YourApp::Controller::auth::check_level });
$r->under( \&YourApp::Controller::auth::check_level ); # "same"
But I prefer ->to( 'controller#action' ) syntax. It looks much better
What if we use this approach?
# register condition
$r->add_condition(
chain => sub {
my ($route, $controller, $captures, $checkers) = #_;
for my $checker (#$checkers) {
return 0 unless $checker->($route, $controller, $captures);
}
return 1;
},
);
# ...
# example of using
$r->get('/')->over(chain => [\&checker1, \&checker2])->to(cb => \&foo)->name('bar');
I am using a DB::CDBI class for accessing the database in our application. Our project is in object-oriented Perl.
package LT::LanguageImport;
use strict;
use warnings;
use base 'Misk5::CDBI';
__PACKAGE__->table( 'english_text_translation' );
__PACKAGE__->columns( Primary => qw/english language translation/ );
__PACKAGE__->columns( Essential => qw/english language translation/ );
__PACKAGE__->has_a( english => 'LT::EnglishLanguage' );
In one such scenario, I am supposed to check if a row in a table exists. I am using the built-in search API in a CDBI call.
sub find_translation {
my $translation_exists_r_not = $class->search(
english => $english,
language => $language,
translation => $translation
);
return;
}
$translation_exists_r_not is getting the expected values depending on the inputs given in the search. If the row exists, then the _data is updated with the row details.
$translation_exists_r_not = bless({
'_data' => [
{
'language' => 'polish',
'translation' => 'Admin',
'english' => 'admin'
}
],
'_place' => 0,
'_mapper' => [],
'_class' => 'LT::LanguageImport'
},
'Class::DBI::Iterator'
);
If the row desn't exist, then I get a return value like this.
$translation_exists_r_not = bless({
'_data' => [],
'_place' => 0,
'_mapper' => [],
'_class' => 'LT::LanguageImport'
},
'Class::DBI::Iterator'
);
I want to return the value of translation from this sub find_translation depending on the search result. I am not able to get a best condition for this.
I tried copying the _data into an array, but I'm not sure how to proceed further. As _data will be an empty arrayref and another condition it will have a hashref inside the arrayref.
my #Arr = $translation_exists_r_not->{'_data'};
CDBI's search method will return an iterator, because there may be multiple rows returned depending on your criteria.
If you know there can be only one row that matches your criteria, you want to use the retrieve method, i.e.:
if (my $translation_exists_r_not = $class->retrieve(
english => $english,
language => $language,
translation => $translation
)){
return [$translation_exists_r_not->translation,
'Misk5::TranslationAlreadyExists']
}
else {
return [ '', undef ]
}
And if multiple rows can be returned from your search, and you're only interested in the truthiness, then again, don't be rummaging around inside the CDBI::Iterator, but use its methods:
my $translation_exists_r_not = $class->search(
english => $english,
language => $language,
translation => $translation
); # returns an iterator
if ($translation_exists_r_not){
my $first = $translation_exists_r_not->first;
return [ $first->translation, 'Misk5::TranslationAlreadyExists' ]
}
Have a look at perldoc Class::DBI and perldoc Class::DBI::Iterator. CDBI has excellent documentation.
I think I got the solution. Thanks to whoever has tried to solve it.
my #req_array = %$translation_exists_r_not->{_data};
my $length_of_data = '9';
foreach my $elem (#req_array) {
$length_of_data = #{$elem};
}
Now check the length of the array.
if ($length_of_data == 0) {
$error = '';
$result = [undef, $error];
}
Now check if it is one.
if ($length_of_data == 1) {
my #result_array = #{%$translation_exists_r_not->{_data}};
my $translation = $result_array[0]{'translation'};
$error = 'Misk5::TranslationAlreadyExists';
$result = [$translation, $error];
}
return #$result;
I decided to use eXist as a database for an application that I am writing in Perl and
I am experimenting with it. The problem is that I have stored a .xml document with the following structure
<foo-bar00>
<perfdata datum="GigabitEthernet3_0_18">
<cli cmd="whatsup" detail="GigabitEthernet3/0/18" find="" given="">
<input_rate>3</input_rate>
<output_rate>3</output_rate>
</cli>
</perfdata>
<timeline>2011-5-23T11:15:33</timeline>
</foo-bar00>
and it is located in the "/db/LAB/foo-bar00/2011/5/23/11_15_33.xml" collection.
I can successfully query it, like
my $xquery = 'doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")' ;
or $xquery can be equal to
= doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")/foo-bar00/perfdata/cli/data(output_rate)
or
= doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")/foo-bar00/data(timeline)
my ($rc1, $set) = $eXist->executeQuery($xquery) ;
my ($rc2, $count) = $eXist->numberOfResults($set) ;
my ($rc3, #data) = $eXist->retrieveResults($set) ;
$eXist->releaseResultSet($set) ;
print Dumper(#data) ;
And the result is :
$VAR1 = {
'hitCount' => 1,
'foo-bar00' => {
'perfdata' => {
'cli' => {
'given' => '',
'detail' => 'GigabitEthernet3/0/18',
'input_rate' => '3',
'cmd' => 'whatsup',
'output_rate' => '3',
'find' => ''
},
'datum' => 'GigabitEthernet3_0_18'
},
'timeline' => '2011-5-23T11:15:33'
}
};
---> Given that I know the xml document that I want to retrieve info from.
---> Given that I want to retrieve the timeline information.
When I am writing :
my $db_xml_doc = "/db/LAB/foo-bar00/2011/5/23/11_15_33.xml" ;
my ($db_rc, $db_datum) = $eXist->queryXPath("/foo-bar00/timeline", $db_xml_doc, "") ;
print Dumper($db_datum) ;
The result is :
$VAR1 = {
'hash' => 1717362942,
'id' => 3,
'results' => [
{
'node_id' => '1.2',
'document' => '/db/LAB/foo-bar00/2011/5/23/11_15_33.xml'
}
]
};
The question is : How can I retrieve the "timeline" info ? Seems that the "node_id" variable (=1.2) can points to the "timeline" info, but how can I use it ?
Thank you.
use XML::LibXML qw( );
my $parser = XML::LibXML->new();
my $doc = $parser->parse_file('a.xml');
my $root = $doc->documentElement();
my ($timeline) = $root->findnodes('timeline');
if ($timeline) {
print("Exists: ", $timeline->textContent(), "\n");
}
or
my ($timeline) = $root->findnodes('timeline/text()');
if ($timeline) {
print("Exists: ", $timeline->getValue(), "\n");
}
I could have used /foo-bar00/timeline instead of timeline, but I didn't see the need.
Don't know if you're still interested, but you could either retrieve the doc as DOM and apply an xquery to the DOM, or, probably better, only pull out the info you want in the query that you submit to the server.
Something like this:
for $p in doc("/db/LAB/foo-bar00/2011/5/23/11_15_33.xml")//output_rate
return
<vlaue>$p</value>
I have the following script that scrapes my schools CS department to get a list of all the courses. I want to be able to extract the CRN (course number) and other important information to put into a database which I can let users browse through a web app.
Here is an example URL:
http://courses.illinois.edu/cis/2011/spring/schedule/CS/411.html
I would like to extract info from pages like this. The first level of the scraper just constructs the individual sites from a list of all of the courses. Once I'm at a course specific catalog page, I use the second scraper to attempt to get all of this info i want. For some reason, although the CRN's and Course Instructors are all 'td' elements. My scraper seems to be returning nothing when scraping. I tried to scrape specifically for 'div' instead and I get a bunch of info for each relevant page. So somehow I'm failing to get the 'td' element, but I'm scraping from the right page.
my $tweets = scraper {
# Parse all LIs with the class "status", store them into a resulting
# array 'tweets'. We embed another scraper for each tweet.
# process "h4.ws-ds-name.detail-title", "array[]" => 'TEXT';
process "div.ws-row", "array[]" => 'TEXT';
};
my $res = $tweets->scrape( URI- >new("http://courses.illinois.edu/cis/2011/spring/schedule/CS/index.html?skinId=2169") );
foreach my $elem (#{$res->{array}}){
my $coursenum = substr($elem,2,4);
my $secondLevel = scraper{
process "td.ws-row", "array2[]" => 'TEXT';
};
my $res2 = $secondLevel->scrape(URI- >new("http://courses.illinois.edu/cis/2011/spring/schedule/CS/$coursenum.html"));
my $num = #{$res2->{array2}};
print $num;
print "---------------------", "\n";
my #curr = #{$res2->{array2}};
foreach my $elem2 (#curr){
$num++;
print $elem2, " ", "\n";
}
print "---------------------", "\n";
}
Any ideas?
Thanks
Looks to me like
my $coursenum = substr($elem,2,4)
should be
my $coursenum = substr($elem,3,3)
The easiest way to go in this case is use
HTML::TableExtract
In case you are looking for data from the table only.
I played a bit with your problem. You can get course id, title and link to individual course page within initial scraper:
my $courses = scraper {
process 'div.ws-row',
'course[]' => scraper {
process 'div.ws-course-number', 'id' => 'TEXT';
process 'div.ws-course-title', 'title' => 'TEXT';
process 'div.ws-course-title a', 'link' => '#href';
};
result 'course';
};
The result of scraping is arrayref with hashrefs like this:
{ id => "CS 103",
title => "Introduction to Programming",
link => bless(do{\(my $o = "http://courses.illinois.edu/cis/2011/spring/schedule/CS/103.html?skinId=2169")}, "URI::http"),
},
....
Then you can do additional scraping for each course from their individual pages and add such information into original structure:
for my $course (#$res) {
my $crs_scraper = scraper {
process 'div.ws-description', 'desc' => 'TEXT';
# ... add more items here
};
my $additional_data = $crs_scraper->scrape(URI->new($course->{link}));
# slice assignment to add them into course definition
#{$course}{ keys %$additional_data } = values %$additional_data;
}
Source combined together is as follows:
use strict; use warnings;
use URI;
use Web::Scraper;
use Data::Dump qw(dump);
my $url = 'http://courses.illinois.edu/cis/2011/spring/schedule/CS/index.html?skinId=2169';
my $courses = scraper {
process 'div.ws-row',
'course[]' => scraper {
process 'div.ws-course-number', 'id' => 'TEXT';
process 'div.ws-course-title', 'title' => 'TEXT';
process 'div.ws-course-title a', 'link' => '#href';
};
result 'course';
};
my $res = $courses->scrape(URI->new($url));
for my $course (#$res) {
my $crs_scraper = scraper {
process 'div.ws-description', 'desc' => 'TEXT';
# ... add more items here
};
my $additional_data = $crs_scraper->scrape(URI->new($course->{link}));
# slice assignment to add them into course definition
#{$course}{ keys %$additional_data } = values %$additional_data;
}
dump $res;