socks 5 proxy on Perl - perl

I am new in Perl and trying to understand this cod in Link : http://codepaste.ru/1374/but I have some problem in understanding this part of code:
while($client || $target) {
my $rin = "";
vec($rin, fileno($client), 1) = 1 if $client;
vec($rin, fileno($target), 1) = 1 if $target;
my($rout, $eout);
select($rout = $rin, undef, $eout = $rin, 120);
if (!$rout && !$eout) { return; }
my $cbuffer = "";
my $tbuffer = "";
if ($client && (vec($eout, fileno($client), 1) || vec($rout, fileno($client), 1))) {
my $result = sysread($client, $tbuffer, 1024);
if (!defined($result) || !$result) { return; }
}
if ($target && (vec($eout, fileno($target), 1) || vec($rout, fileno($target), 1))) {
my $result = sysread($target, $cbuffer, 1024);
if (!defined($result) || !$result) { return; }
}
if ($fh && $tbuffer) { print $fh $tbuffer; }
while (my $len = length($tbuffer)) {
my $res = syswrite($target, $tbuffer, $len);
if ($res > 0) { $tbuffer = substr($tbuffer, $res); } else { return; }
}
while (my $len = length($cbuffer)) {
my $res = syswrite($client, $cbuffer, $len);
if ($res > 0) { $cbuffer = substr($cbuffer, $res); } else { return; }
}
}
can any body explain to me exactly whats happen in these lines:
vec($rin, fileno($client), 1) = 1 if $client;
vec($rin, fileno($target), 1) = 1 if $target;
and
select($rout = $rin, undef, $eout = $rin, 120);

Basically, the select operator is used to find which of your file descriptors are ready (readable, writable or there's an error condition). It will wait until one of the file descriptors is ready, or timeout.
select RBITS, WBITS, EBITS, TIMEOUT
RBITS is a bit mask, usually stored as a string, representing a set of file descriptors that select will wait for readability. Each bit of RBITS represent a file descriptor, and the offset of the file descriptor in this bit mask should the file descriptor number in system. Thus, you could use vec to generate this bit mask.
vec EXPR, OFFSET, BITS
The vec function provides storage of lists of unsigned integers. EXPR is a bit string, OFFSET is the offset of bit in EXPR, and BITS specifies the width of each element you're reading from / writing to EXPR.
So these 2 lines:
vec($rin, fileno($client), 1) = 1;
vec($rin, fileno($target), 1) = 1;
They made up a bit mask string $rin with setting the bit whose offset equals the file descriptor number of $client, as well as the one of $target.
Put it into select operator:
select($rout = $rin, undef, $eout = $rin, 120);
Then select will monitor the readability of the two file handlers ($client and $target), if one of them is ready, select will return. Or it will return after 120s if no one is ready.
WBITS, EBITS use the same methodology. So you could infer that the above select line will also return when the two file handler have any exceptions.

Related

Is it possible mod_sms with mod_callcenter?

I've set up Freeswitch and simple hotline using mod_callcenter and it works fine. I'm curious whether it would be possible to set text-chat hotline by combine mod_sms with mod_callcenter. Maybe different modules should be used for that?
I'm not sure, but this might offer some insights you need to get you going: http://www.thenoccave.com/2012/03/05/freeswitch-callcenter-sms-alerts/
The PHP code that was written is as follows:
#!/usr/bin/php
<?php
$GLOBALS['server'] = 'localhost';
$GLOBALS['port'] = '8021';
$GLOBALS['password'] = 'ClueCon';
$GLOBALS['clickatellapi_id'] = '1234456';
$GLOBALS['clickatelluser'] = 'username';
$GLOBALS['clickatellpassword'] = 'password';
$GLOBALS['contactnumbers'][] = '61123456789';
$GLOBALS['contactnumbers'][] = '61987654321';
$queuealerter = array();
require_once('/usr/local/freeswitch/scripts/ESL.php');
function sendnotification($queuename){
$message = 'There is a call in the queue ' . $queuename . ' and no agents are logged in to take it';
for($i=0; $i < count($GLOBALS['contactnumbers']); $i++){
$curl_handle = curl_init();
curl_setopt($curl_handle, CURLOPT_URL,'http://api.clickatell.com/http/sendmsg?api_id=' . $GLOBALS['clickatellapi_id'] . '&user=' . $GLOBALS['clickatelluser'] . '&password=' . $GLOBALS['clickatellpassword'] . '&to=' . $GLOBALS['contactnumbers'][$i] . '&text=' . urlencode($message));
curl_exec($curl_handle);
curl_close($curl_handle);
}
}
$sock = new ESLconnection($GLOBALS['server'], $GLOBALS['port'], $GLOBALS['password']);
$res = $sock->api('callcenter_config queue list');
$queuelist = preg_split('/\r\n|\r|\n/', $res->getBody());
//get a list of all the queues
for($i=1; $i < count($queuelist); $i++){
$queuedetails = explode('|', $queuelist[$i]);
if($queuedetails[0] != '+OK' && $queuedetails[0] != ''){
$newQueue = array();
$newQueue['Name'] = $queuedetails[0];
$newQueue['AgentCount'] = 0;
$newQueue['CallCount'] = 0;
$queuealerter['Queues'][] = $newQueue;
}
}
//for each queue check if there is a logged in agent
for($i=0; $i < count($queuealerter['Queues']); $i++){
$res = $sock->api('callcenter_config queue list agents ' . $queuealerter['Queues'][$i]['Name']);
$agentdetails = preg_split('/\r\n|\r|\n/', $res->getBody());
for($i2=1; $i2 < count($agentdetails); $i2++){
$agentdetail = explode('|', $agentdetails[$i2]);
if($agentdetail[0] != '+OK' && $agentdetail[0] != '' && $agentdetail[5] == 'Available'){
$queuealerter['Queues'][$i]['AgentCount'] += 1;
}
}
//get all the calls in the queue
$res = $sock->api('callcenter_config queue list members ' . $queuealerter['Queues'][$i]['Name']);
$calldetails = preg_split('/\r\n|\r|\n/', $res->getBody());
for($i2=1; $i2 < count($calldetails); $i2++){
$calldetail = explode('|', $calldetails[$i2]);
if($calldetail[0] != '+OK' && $calldetail[0] != ''){
$queuealerter['Queues'][$i]['CallCount'] += 1;
}
}
}
//for each queue check
for($i=0; $i < count ($queuealerter['Queues']); $i++){
if($queuealerter['Queues'][$i]['CallCount'] > 0 && $queuealerter['Queues'][$i]['AgentCount'] == 0){
sendnotification($queuealerter['Queues'][$i]['Name']);
}
}
?>

Perl script appending date

Am running this perl script ever day on my server and am getting the below output for the script. I am trying to modify the script to also include the current hour as part of the output. How can I go about doing this?
This is my current script:
#!/usr/bin/perl
#Prism Performance log Parser
use strict;
my $cbal_total;
my $cbal_count =0;
my $stck_total = 0;
my $stck_count =0;
my $chg_total = 0;
my $chg_count =0;
my $rmac_total = 0;
my $rmac_count =0;
my $rmd_total = 0;
my $rmd_count =0;
my $cbalT;
my $stckT;
my $rmacT;
my $rmdT;
my $chgT;
my $total;
my $count;
my $cbal;
my $stck;
my $hour;
my $chg;
my $rmac;
my $rmd;
my $lesThresh=0;
my $gtThresh=0;
my $stck_lesThresh=0;
my $stck_gtThresh=0;
my $rmd_lesThresh=0;
my $rmd_gtThresh=0;
my $chg_lesThresh=0;
my $chg_gtThresh=0;
my $rmac_lesThresh=0;
my $rmac_gtThresh=0;
my %CheckBal;
my %SubTypeCheck;
my %charging;
my %remoteAct;
my %remoteDct;
my $chgkey;
my $cbalkey;
my $stckkey;
my $rmackey;
my $rmdkey;
my #value;
my $ct;
my $component;
my $component2;
while (my $line =<>) {
chomp;
s/\r//g;
my #f = split(/\|/, $line);
my $i;
$hour = substr($f[0],11,2);
for ($i==0;$i<=100; $i++) {
if (($f[$i]=~m/CBAL/) && ($f[$i]!~m/CBAL,100/)) {
$component="CBAL";
$cbal=$f[$i];
$cbalkey="$hour,$component";
if (!exists($CheckBal{$cbalkey})) {
$cbal_count=0;
$cbal_total=0;
$lesThresh=0;
$gtThresh=0;
}
$cbalT = substr($cbal,index($cbal,",T=")+3,index($cbal,"\n"));
if ($cbalT <= 300) {
$lesThresh++;
}else{
$gtThresh++
}
$cbal_total +=$cbalT;
$cbal_count ++;
#$CheckBal{$cbalkey} =($cbal_total).",".($cbal_count).",".($lesThresh).",".$gtThresh.",".($cbal_total/$cbal_count);
$CheckBal{$cbalkey} =($cbal_count).",".($cbal_total).",".($cbal_total/$cbal_count).",".($lesThresh).",".$gtThresh;
}elsif($f[$i]=~m/STCK/){
$component="STCK";
$stck=$f[$i];
$stckkey="$hour,$component";
if (!exists($SubTypeCheck{$stckkey})) {
$stck_count=0;
$stck_total=0;
$stck_lesThresh=0;
$stck_gtThresh=0
}
$stckT = substr($stck,index($stck,",T=")+3,index($stck,"\n"));
if ($stckT <= 300) {
$stck_lesThresh++;
}else{
$stck_gtThresh++
}
$stck_total +=$stckT;
$stck_count ++;
# $SubTypeCheck{$stckkey} =($stck_total).",".($stck_count).",".($stck_lesThresh).",".$stck_gtThresh.",".($stck_total/$stck_count);
$SubTypeCheck{$stckkey} =($stck_count).",".($stck_total).",".($stck_total/$stck_count).",".($stck_lesThresh).",".$stck_gtThresh;
}elsif($f[$i]=~m/CHG/){
$component="CHG";
$chg=$f[$i];
$chgkey="$hour,$component";
if (!exists($charging{$chgkey})) {
$chg_count=0;
$chg_total=0;
$chg_lesThresh=0;
$chg_gtThresh=0
}
$chgT = substr($chg,index($chg,",T=")+3,index($chg,"\n"));
if ($chgT <= 300) {
$chg_lesThresh++;
}else{
$chg_gtThresh++
}
$chg_total +=$chgT;
$chg_count ++;
# $charging{$chgkey} =($chg_total).",".($chg_count).",".($chg_lesThresh).",".$chg_gtThresh.",".($chg_total/$chg_count);
$charging{$chgkey} =($chg_count).",".($chg_total).",".($chg_total/$chg_count).",".($chg_lesThresh).",".$chg_gtThresh;
}elsif(($f[$i]=~m/RMAC/) && ($f[$i]!~m/RMAC,96/)){
$component="RMAC";
$rmac=$f[$i];
$rmackey="$hour,$component";
if (!exists($remoteAct{$rmackey})) {
$rmac_count=0;
$rmac_total=0;
$rmac_lesThresh=0;
$rmac_gtThresh=0
}
$rmacT = substr($rmac,index($rmac,",T=")+3,index($rmac,"\n"));
if ($rmacT <= 300) {
$rmac_lesThresh++;
}else{
$rmac_gtThresh++
}
$rmac_total +=$rmacT;
$rmac_count ++;
# $remoteAct{$rmackey} =($rmac_total).",".($rmac_count).",".($rmac_lesThresh).",".$rmac_gtThresh.",".($rmac_total/$rmac_count);
$remoteAct{$rmackey} =($rmac_count).",".($rmac_total).",".($rmac_total/$rmac_count).",".($rmac_lesThresh).",".$rmac_gtThresh;
}elsif(($f[$i]=~m/RMD/) && ($f[$i]!~m/RMD,96/)){
$component="RMD";
$rmd=$f[$i];
$rmdkey="$hour,$component";
if (!exists($remoteDct{$rmdkey})) {
$rmd_count=0;
$rmd_total=0;
$rmd_lesThresh=0;
$rmd_gtThresh=0
}
$rmdT = substr($rmd,index($rmd,",T=")+3,index($rmd,"\n"));
if ($rmdT <= 300) {
$rmd_lesThresh++;
}else{
$rmd_gtThresh++
}
$rmd_total +=$rmdT;
$rmd_count ++;
# $remoteDct{$rmdkey} =($rmd_total).",".($rmd_count).",".($rmd_lesThresh).",".$rmd_gtThresh.",".($rmd_total/$rmd_count);
$remoteDct{$rmdkey} =($rmd_count).",".($rmd_total).",".($rmd_total/$rmd_count).",".($rmd_lesThresh).",".$rmd_gtThresh;
}
}
}
print "Balance Check\n";
print "Hour,Task,Total Transactions,Total Processing Time/ms,Average TPS/ms,<300 ms,>300 ms\n";
unless(%CheckBal){
print "No record found for STCK\n";
}
foreach (sort keys %CheckBal){
print $_.",".$CheckBal{$_}."\n";
}
Current Output:
Balance Check
Hour,Task,Total Transactions,Total Processing Time/ms,Average TPS/ms,<300 ms,>300 ms
06,CBAL,17987,13131831,730.073441930283,4295,13692
07,CBAL,17911,13579801,758.182178549495,3970,13941
08,CBAL,228,98643,432.644736842105,100,128
Desired Output:
Balance Check
date,Hour,Task,Total Transactions,Total Processing Time/ms,Average TPS/ms,<300 ms,>300 ms
20140528,06,CBAL,17987,13131831,730.073441930283,4295,13692
20140528,07,CBAL,17911,13579801,758.182178549495,3970,13941
20140528,08,CBAL,228,98643,432.644736842105,100,128
To get the current hour, use Time::Piece
use strict;
use warnings;
use Time::Piece;
print localtime->strftime("%H"), "\n";
How to insert that functionality into your script is an exercise for you.

How to cluster based on ssdeep?

Hi I am trying to find the groups out of files based on ssdeep.
I have generated ssdeep of files and kept it in csv file.
I am parsing the file in perl script as follows:
foreach( #all_lines )
{
chomp;
my $line = $_;
my #split_array = split(/,/, $line);
my $md5 = $split_array[1];
my $ssdeep = $split_array[4];
my $blk_size = (split(/:/, $ssdeep))[0];
if( $blk_size ne "")
{
my $cluster_id = check_In_Cluster($ssdeep);
print WFp "$cluster_id,$md5,$ssdeep\n";
}
}
This also checks whether the ssdeep is present in previously clustered group and if not creates new group.
Code for chec_In_Cluster
my $ssdeep = shift;
my $cmp_result;
if( $cluster_cnt > 0 ) {
$cmp_result = ssdeep_compare( $MRU_ssdeep, $ssdeep );
if( $cmp_result > 85 ) {
return $MRU_cnt;
}
}
my $d = int($cluster_cnt/4);
my $thr1 = threads->create(\&check, 0, $d, $ssdeep);
my $thr2 = threads->create(\&check, $d, 2*$d, $ssdeep);
my $thr3 = threads->create(\&check, 2*$d, 3*$d, $ssdeep);
my $thr4 = threads->create(\&check, 3*$d, $cluster_cnt, $ssdeep);
my ($ret1, $ret2, $ret3, $ret4);
$ret1 = $thr1->join();
$ret2 = $thr2->join();
$ret3 = $thr3->join();
$ret4 = $thr4->join();
if($ret1 != -1) {
$MRU_ssdeep = $ssdeep;
$MRU_cnt = $ret1;
return $MRU_cnt;
} elsif($ret2 != -1) {
$MRU_ssdeep = $ssdeep;
$MRU_cnt = $ret2;
return $MRU_cnt;
} elsif($ret3 != -1) {
$MRU_ssdeep = $ssdeep;
$MRU_cnt = $ret3;
return $MRU_cnt;
} elsif($ret4 != -1) {
$MRU_ssdeep = $ssdeep;
$MRU_cnt = $ret4;
return $MRU_cnt;
} else {
$cluster_base[$cluster_cnt] = $ssdeep;
$MRU_ssdeep = $ssdeep;
$MRU_cnt = $cluster_cnt;
$cluster_cnt++;
return $MRU_cnt;
}
and the code for chech:
sub check($$$) {
my $from = shift;
my $to = shift;
my $ssdeep = shift;
for( my $icnt = $from; $icnt < $to; $icnt++ ) {
my $cmp_result = ssdeep_compare( $cluster_base[$icnt], $ssdeep );
if( $cmp_result > 85 ) {
return $icnt;
}
}
return -1;
}
But this process takes very much time( for 20-30MB csv file it takes 8-9Hours).
I have also tried using multithreading while checking in Cluster but not much help i got from this.
Since their is no need of csv parser like Text::CSV (because of less operation on csv) i didn't used it.
can anybody please solve my issue? Is it possible to use hadoop or some other frameworks for grouping based on ssdeep?
There is a hint from Optimizing ssDeep for use at scale (2015-11-27).
Depends on your purpose, loop and match SSDEEP in different chunk size will create a N x (N-1) hash comparison. Unless you need to find partial contents, otherwise, avoid it.
It is possible to breakdown of the hash index in step 1 as suggested in the article. This is a better way for partial contents match with different chunk size.
It is possible to reduce SSDEEP hash by grouping similar hash by generate a "distance cousin" hash.

Modify code to auto complete on taxonomies instead of title

I've been trying for hours to modify this plugin to work with custom taxonomies instead of post titles and/or post content
http://wordpress.org/extend/plugins/kau-boys-autocompleter/
Added the code / part of the plugin where I think the modification should be done. I could post some stuff I tried but I think it would just confuse people, I don't think I ever came close. Normally I can modify code perfectly but just can't seem to find it. I've tried this method posted here.
http://wordpress.org/support/topic/autocomplete-taxonomy-in-stead-of-title-or-content
But it doesn't work. I've tried searching for possible solutions around his suggestion but I'm starting to think his suggestion isn't even close to fixing it.
if(WP_DEBUG){
error_reporting(E_ALL);
} else {
error_reporting(0);
}
header('Content-Type: text/html; charset=utf-8');
// remove the filter functions from relevanssi
if(function_exists('relevanssi_kill')) remove_filter('posts_where', 'relevanssi_kill');
if(function_exists('relevanssi_query')) remove_filter('the_posts', 'relevanssi_query');
if(function_exists('relevanssi_kill')) remove_filter('post_limits', 'relevanssi_getLimit');
$choices = get_option('kau-boys_autocompleter_choices');
$framework = get_option('kau-boys_autocompleter_framework');
$encoding = get_option('kau-boys_autocompleter_encoding');
$searchfields = get_option('kau-boys_autocompleter_searchfields');
$resultfields = get_option('kau-boys_autocompleter_resultfields');
$titlelength = get_option('kau-boys_autocompleter_titlelength');
$contentlength = get_option('kau-boys_autocompleter_contentlength');
if(empty($choices)) $choices = 10;
if(empty($framework)) $framework = 'jQuery';
if(empty($encoding)) $encoding = 'UTF-8';
if(empty($searchfields)) $searchfields = 'both';
if(empty($resultfields)) $resultfields = 'both';
if(empty($titlelength)) $titlelength = 50;
if(empty($contentlength)) $contentlength = 120;
mb_internal_encoding($encoding);
mb_regex_encoding($encoding);
$words = '%'.$_REQUEST['q'].'%';
switch($searchfields){
case 'post_title' :
$where = 'post_title LIKE "'.$words.'"';
break;
case 'post_content' :
$where = 'post_content LIKE "'.$words.'"';
default :
$where = 'post_title LIKE "'.$words.'" OR post_content LIKE "'.$words.'"';
}
$wp_query = new WP_Query();
$wp_query->query(array(
's' => $_REQUEST['q'],
'showposts' => $choices,
'post_status' => 'publish'
));
$posts = $wp_query->posts;
$results = array();
foreach ($posts as $key => $post){
setup_postdata($post);
$title = strip_tags(html_entity_decode(get_the_title($post->ID), ENT_NOQUOTES, 'UTF-8'));
$content = strip_tags(strip_shortcodes(html_entity_decode(get_the_content($post->ID), ENT_NOQUOTES, 'UTF-8')));
if(mb_strpos(mb_strtolower(($searchfields == 'post_title')? $title : (($searchfields == 'post_content')? $content : $title.$content)), mb_strtolower($_REQUEST['q'])) !== false){
$results[] = array(
'url' => get_permalink($post->ID),
'title' => highlightSearchString(strtruncate($title, $titlelength, true), $_REQUEST['q']),
'content' => (($resultfields == 'both')? highlightSearchString(strtruncate($content, $contentlength, false, '[...]', $_REQUEST['q']), $_REQUEST['q']) : '')
);
}
}
printResults($results, $framework);
function highlightSearchString($value, $searchString){
if((version_compare(phpversion(), '5.0') < 0) && (strtolower(mb_internal_encoding()) == 'utf-8')){
$value = utf8_encode(html_entity_decode(utf8_decode($value)));
}
$regex_chars = '\.+?(){}[]^$';
for ($i=0; $i<mb_strlen($regex_chars); $i++) {
$char = mb_substr($regex_chars, $i, 1);
$searchString = str_replace($char, '\\'.$char, $searchString);
}
$searchString = '(.*)('.$searchString.')(.*)';
return mb_eregi_replace($searchString, '\1<span class="ac_match">\2</span>\3', $value);
}
function strtruncate($str, $length = 50, $cutWord = false, $suffix = '...', $needle = ''){
$str = trim($str);
if((version_compare(phpversion(), '5.0') < 0) && (strtolower(mb_internal_encoding()) == 'utf-8')){
$str = utf8_encode(html_entity_decode(utf8_decode($str)));
}else{
$str = html_entity_decode($str, ENT_NOQUOTES, mb_internal_encoding());
}
if(mb_strlen($str)>$length){
if(!empty($needle) && mb_strpos(mb_strtolower($str), mb_strtolower($needle)) > 0){
$pos = mb_strpos(mb_strtolower($str), mb_strtolower($needle)) + (mb_strlen($needle) / 2);
$startToShort = ($pos - ($length / 2)) < 0;
$endToShort = ($pos + ($length / 2)) > mb_strlen($str);
// build the prefix and suffix
$prefix = $suffix;
if($startToShort){
$prefix = '';
}
if($endToShort){
$suffix = '';
}
// set maximum length
$length = $length - mb_strlen($prefix) - mb_strlen($suffix);
// get the start
if($startToShort){
$start = 0;
} elseif($endToShort){
$start = mb_strlen($str) - $length;
} else {
$start = $pos - ($length / 2);
}
// shorten the string
$string = mb_substr($str, $start, $length);
if($cutWord){
return $prefix.$string.$suffix;
} else {
$firstWhitespace = ($startToShort)? 0 : mb_strpos($string, ' ');
$lastWhitespace =($endToShort)? mb_strlen($string) : mb_strrpos($string, ' ');
return $prefix.' '.(!empty($lastWhitespace)? mb_substr($string, $firstWhitespace, ($lastWhitespace - $firstWhitespace)) : $string).' '.$suffix;
}
} else {
$string = mb_substr($str, 0, $length - mb_strlen($suffix));
return (($cutWord) ? $string : mb_substr($string, 0, mb_strrpos($string, ' ')).' ').$suffix;
}
} else {
return $str;
}
}
function printResults($results, $framework){
if($framework == 'scriptaculous'){
echo '<ul>';
foreach($results as $result){
echo ' <li>
<a href="'.$result['url'].'">
<span class="title">'.$result['title'].'</span>
<span style="display: block;">'.$result['content'].'</span>
</a>
</li>';
}
echo '</ul>';
} else {
foreach($results as $result){
echo str_replace(array("\n", "\r", '|'), array(' ',' ', '|'), '<span class="title">'.$result['title'].'</span><p>'.$result['content'].'</p>')
.'|'
.str_replace(array("\n", "\r", '|'), array(' ',' ', '|'), $result['url'])
."\n";
}
}
}

Does any one have a working script of LoadRunner Automation API?

Currently I am writing Perl script that creates LoadRunner scenario, execute the test, collect the result, recover the environment and repeat the cycle again with different scenario variables.
I don't have a problem creating new scenario, adding generator, adding 2 groups + script + the run-time settings. But I am having a problem with:
Setting scenario schedule from "Scenario" to "Group".
Setting schedule per group
This the snippet of the code:
use strict;
use v5.10;
use Win32::OLE;
use Win32::OLE::Enum;
use Win32::OLE::Variant;
use Data::Dumper;
use Win32::OLE::Const 'LoadRunner Automation Library';
use constant False => Variant(VT_BOOL,'');
use constant True => Variant(VT_BOOL,1);
my $lrEngine = Win32::OLE->new('wlrun.LrEngine') or die "oops\n";
my $lrScenario = $lrEngine->Scenario();
my $rc = $lrScenario->new(0, 1); # do not save previous, Regular vusers based scenario
if ($rc != 0) {
print "Win32::OLE::LastError: ".Win32::OLE::LastError()."\n";
print "lrScenario->new(0, 1):rc: $rc\n";
}
# snip-snipped - add generator
# snip-snipped - add #groups definition
foreach my $group (#groups) {
print "scriptName: $group->{scriptName}\n";
my $scriptLocation = $group->{scriptLocation};
my $scriptName = Variant(VT_BSTR|VT_BYREF, $group->{scriptName});
{ # add $group->{scriptName} script
$rc = $lrScenario->Scripts->Add($scriptLocation, $scriptName);
if ($rc != 0) {
print "Win32::OLE::LastError: ".Win32::OLE::LastError()."\n";
print "lrScenario->Scripts->Add($scriptLocation, $scriptName):rc: $rc\n";
}
}
#############################################################################
my $groupName = Variant(VT_BSTR|VT_BYREF, $group->{groupName});
{ # add $group->{groupName} group
$rc = $lrScenario->Groups->Add($groupName);
if ($rc != 0) {
print "Win32::OLE::LastError: ".Win32::OLE::LastError()."\n";
print "lrScenario->Groups->Add:rc: $rc\n";
}
$rc = $lrScenario->Groups->Item($groupName)->AddVusers($scriptName, $hostname, 3);
if ($rc != 0) {
print "Win32::OLE::LastError: ".Win32::OLE::LastError()."\n";
print "lrScenario->Groups->Item($groupName)->AddVusers:rc: $rc\n";
}
}
#############################################################################
# snip-snipped - change group script run time setting
}
my $scheduleName = Variant(VT_BSTR|VT_BYREF, 'Schedule123');
my $lrManualScheduleData = $lrScenario->ManualScheduler->AddSchedule($scheduleName, lrGroupSchedule); # Scenario schedule mode
if (!$lrManualScheduleData) {
say "Win32::OLE::LastError: ".Win32::OLE::LastError();
say "lrScenario->ManualScheduler->AddSchedule:rc: $rc";
}
$rc = $lrScenario->ManualScheduler->SetCurrentSchedule($scheduleName);
if ($rc != 0) {
say "Win32::OLE::LastError: ".Win32::OLE::LastError();
say "lrScenario->ManualScheduler->SetCurrentSchedule:rc: $rc";
}
print "\$lrScenario->ManualScheduler->SetScheduleMode($scheduleName, lrGroupSchedule):";
$lrScenario->ManualScheduler->SetScheduleMode($scheduleName, lrGroupSchedule);
#LrManualScheduleMode -> lrGroupSchedule = 1, lrScenarioSchedule = 0
say "Win32::OLE::LastError: ".Win32::OLE::LastError();
$lrManualScheduleData->{'InitAllBeforeRun'} = 'True';
$lrManualScheduleData->{'DurationMode'} = 1;
$lrManualScheduleData->{'Duration'} = 60 * 60;
$lrManualScheduleData->{'RampupBatchSize'} = 1;
$lrManualScheduleData->{'RampupMode'} = lrRampupByGroupBatches;
$lrManualScheduleData->{'RampupTimeInterval'} = 5;
$lrManualScheduleData->{'RampdownBatchSize'} = 1;
$lrManualScheduleData->{'RampdownMode'} = lrRampupByGroupBatches;
$lrManualScheduleData->{'RampdownTimeInterval'} = 5;
$rc = $lrScenario->ManualScheduler->{'ScenarioStartTimeMode'} = 0; # Start scenario without delay
#test
say "$scheduleName: ".$lrScenario->ManualScheduler->Schedule($scheduleName)->{'Duration'}; # returns 300
I have the same problem. Setting those properties and then calling either setschedulemode or setcurrentschedule doesn't seem to work. The only workaround I have found is to use the setscheduledata method passing in xml. You will need to get the current xml for the scheduledata and then change the xml, passing in the modified xml to the setscheduledata method. Hopefully this helps
lrManualScheduleData data = engine.Scenario.ManualScheduler.get_Schedule("Schedule 1");
String scheduleXML,errStr;
int returncode = data.getScheduleData(out scheduleXML, out errStr);
// Manipulate the XML to set whatever schedule you want
data.SetScheduleData(scheduleXML, out errStr);