my #banks = #banksDup= ("abs", "qer", "qaz");
my $serverFailedabs;
my $serverFailedqer;
my $serverFailedqaz;
### Some processing of $serverFailedabs, $serverFailedqer and $serverFailedqaz happens here ###
foreach my $bank (#banks) {
if("$serverFailed${bank}" ne "") ## Line 85
{
print "$bank server setup failed;
#banksDup = grep !/${bank}/, #banksDup;
}
}
Error:
Global symbol "$serverFailed" requires explicit package name at perl1.pl line 85
Here, "$serverFailed${bank}" is being considered as $serverFailed in the parsing stage, and giving error. How can I avoid this issue?
I want that "$serverFailed${bank}" is executed during execution so that "$serverFailed${bank}" gets correct value
Use a hash.
my #banks = ( "abs", "qer", "qaz" );
my #banksDup = #banks;
my %serverFailed = (
abs => '',
qer => '',
qaz => '',
);
for my $bank ( #banks ) {
if ( $serverFailed{$bank} ne "" ) {
print "$bank server setup failed\n";
#banksDup = grep $_ ne $bank, #banksDup;
}
}
Related
I'm trying to use Net::LDAPs with Net::LDAP::CONTROL::PAGED to return many records via a privlidged bind, but so far I have failed, miserably. I've used this Net::LDAPs extensively in the past, but I've never been able to find any documentation suggesting that it is compatible with Net::LDAP:Control::Paged. Everything I find is related to Net::LDAP.
The error message I get is: Undefined subroutine &main::process_entry called at /usr/local/share/perl/5.20.2/Net/LDAP/Search.pm line 55, line 755
Here is my code:
sub Ldap636{
my ($filter) = $_[0];
my $USERNAME = 'username';
my $PASSWORD = 'password';
my $LDAP_SERVER = 'directory.domain.edu';
my $LDAP_SSL_PORT = '636';
my $LDAP_BASE = 'ou=people,dc=domain,dc=edu';
my $userDN = "uid=$USERNAME,ou=identities,ou=special,dc=domain,dc=edu";
my $ldap = Net::LDAPS->new($LDAP_SERVER, port => $LDAP_SSL_PORT) or die "Could not create LDAP object because:\n$!";
my $ldapMsg = $ldap->bind($userDN, password => $PASSWORD);
die $ldapMsg->error if $ldapMsg->is_error;
my $page = Net::LDAP::Control::Paged->new( size => 100 );
#args = (base => "$LDAP_BASE",
callback => \&process_entry,
filter => $filter,
control => [ $page ],
);
my $cookie;
while (1) {
my $result = $ldap->search(#args);
"LDAP error: server says ",$result->error,"\n" if $result->code;
foreach my $entry ($result->entries ) {
my $cn = $entry->get_value('cn');
my $desc = $entry->get_value('description');
print "$cn - $desc\n";
}
# Get cookie from paged control
my($resp) = $result->control( LDAP_CONTROL_PAGED ) or last;
$cookie = $resp->cookie or last;
$page->cookie($cookie);
}
$ldap->unbind;
}
The error message I get is: Undefined subroutine &main::process_entry
called at /usr/local/share/perl/5.20.2/Net/LDAP/Search.pm line 55,
line 755
You have written process_entry as a callback but you didn't write that subroutine. That's why you are getting the above error.
I have a script(Perl) which is taking a string from database through a variable and writing to a xml file. if the string contain "&" then while opening xml file it is giving parser error want to replace "&" with & through Perl script.
This is what I have tried
foreach my $ActiveLinkInfo ( #ActiveLinkInfos ) {
my ( $SubCID, $Subf, $Subt, $Subclosed, $SubCName ) = (
$ActiveLinkInfo->{'SubCID'},
$ActiveLinkInfo->{'Subf'},
$ActiveLinkInfo->{'Subt'},
$ActiveLinkInfo->{'Subclosed'},
$ActiveLinkInfo->{'SubCName'}
);
##$ActiveLinkInfo
if ( $Subf eq "HEADING" ) {
push( #menu, { "Name" => "$SubCName", "Dir" => "HEADING" } );
}
else {
my $res = GetChildren( "$path$SubCID\\", $SubCID, $VID );
$SubCName =~ s/ - .*//;
push( #menu, { "Name" => "$SubCName", "Dir" => "$SubCID/default.aspx" } );
}
}
If you're trying to convert text to HTML, use HTML::Entities.
You should take a look at the HTML::Escape module, which only translates in one direction -- from text to entities -- but does it very quickly
I am using Hypertable::ThriftClient, and using mutator for mass insertion. Here is the code sample: $master, $port and $namespace are all defined.
Table:
show create table users; # Table schema is below
CREATE TABLE GROUP_COMMIT_INTERVAL "100" users (
'column_name_fake' MAX_VERSIONS 1,
ACCESS GROUP audience ('column_name_fake'),
)
:hypertable$ SELECT * FROM users limit 1; # displays
2342345 sf_following:1000234
2342346 sf_following:1234234
Code:
my $ht = new Hypertable::ThriftClient($master, $port);
my $ns = $ht->namespace_open($namespace);
my $users_mutator = $ht->mutator_open($ns, 'table_name', 2);
Subroutine:
sub batch_insert {
my ($ht, $mutator, $column_family, $row, $val) = #_;
my $keys;
my $cell;
try {
$keys = new Hypertable::ThriftGen::Key({
row => $row,
column_family => $column_family });
$cell = new Hypertable::ThriftGen::Cell({key => $keys, value => $val});
}
catch {
warn Dumper({ 'Error' => $_ });
};
$ht->mutator_set_cell($mutator, $cell);
$ht->mutator_flush($mutator);
return 1;
}
Function called:
for(.....) { # Just for example
batch_insert($ht, $users_mutator, '', $fs, "node:$node_u");
}
Here I get an exception,
Hypertable::ThriftGen::ClientException=HASH(0x54d7380)
Can anyone clarify, why?
Edit: I added table structure for more clarity?
The ClientException class is defined as follows:
exception ClientException {
1: i32 code
2: string message
}
Try catching the exception and printing out the code (in hex) and message. That should help pinpoint what's going on.
FIX: So, this exception is raised is a required parameter 'column_qualifier' was not
passed as per the table design. See below:
sub batch_insert {
my ($ht, $mutator, $cf, $cq, $row, $val) = #_;
my $keys = new Hypertable::ThriftGen::Key({
row => $row,
column_family => $cf,
column_qualifier => $cq });
my $cell = new Hypertable::ThriftGen::Cell({key => $keys, value => $val});
$ht->mutator_set_cell($mutator, $cell);
#$ht->mutator_flush($mutator);
}
Calling the above function:
--------------------------
batch_insert($ht, $users_mutator, 'column_family' , 'column_qualifier, 'row_key', '');
and it worked like a charm. If you are in similar types of issues, Let me know, I can help out. I spent quite a bit of time, reading about the Thrift api.
I have created a script in Perl to connect to LDAP, retrieve values and post them to a CSV file. The values I am retrieving via a query are d"distinguished name, userAccountControl & pwdLastSet. I can pull and parse the first two results correctly and post them to the CSV file, but the pwdLastSet is returning WIN32::OLE=HASH(0x.......). I have tired sprintf, hex(), and the results are either the WIN32 value or 0. I am expecting something 18 digits in length. Thanks for the help.
#!/usr/bin/perl
use xSV;
use Win32;
use Win32::OLE;
# use strict;
.
.
.
.
while ($line = <GROUPS>) {
chomp($line);
if ($line =~ m/^ user .*/) {
$line =~ s/^ user.\s//;
my ($objRootDSE, $strDomain, $strUsername, $objConnection, $objCommand, $objRecordSet, $strDN, $arrSplitResponse, $strLName, $strFName, $strUserType);
use constant ADS_SCOPE_SUBTREE => 2;
# Get domain components
$objRootDSE = Win32::OLE->GetObject('LDAP://RootDSE');
$strDomain = $objRootDSE->Get('DefaultNamingContext');
# Get username to search for
$strUsername = $line;
# Set ADO connection
$objConnection = Win32::OLE->new('ADODB.Connection');
$objConnection->{Provider} = 'ADsDSOObject';
$objConnection->Open('Active Directory Provider');
# Set ADO command
$objCommand = Win32::OLE->new('ADODB.Command');
$objCommand->{ActiveConnection} = $objConnection;
$objCommand->SetProperty("Properties", 'Searchscope', ADS_SCOPE_SUBTREE);
$objCommand->{CommandText} = 'SELECT distinguishedName, userAccountControl, pwdLastSet FROM \'LDAP://' . $strDomain . '\' WHERE objectCategory=\'user\' AND samAccountName = \'' . $strUsername . '\'';
# Set recordset to hold the query result
$objRecordSet = $objCommand->Execute;
# If a user was found - Retrieve the distinguishedName
if (!$objRecordSet->EOF) {
$strDN = $objRecordSet->Fields('distinguishedName')->Value;
$strAcctControl = $objRecordSet->Fields('userAccountControl')->Value;
$strpwdLS = sprintf($objRecordSet->Fields('pwdLastSet')->Value);
#arrSplitResponse = split(/,/, $strDN);
$strLName = substr($arrSplitResponse[0],3);
if ($strLName =~ m/\\$/) {
$strLName = substr($strLName,0,-1);
}
$strFName = $arrSplitResponse[1];
if ($strFName =~ m/OU=/) {
$strUserType = $strFName;
$strFName = "";
$strUserType = substr($strUserType,3);
} else {
$strUserType = substr($arrSplitResponse[2],3);
}
if ($strAcctControl == 512) {
$strAcctControl = "Active";
} else {
$strAcctControl = "Disabled";
}
} else {
print "No user found";
}
&debug("Match!: $line in $group\n");
$csv->print_data(
AccountName => $line,
LastName => $strLName,
FirstName => $strFName,
SYSGenericAcct => $strUserType,
AccessLevel => $group,
AccessCapability => "User",
Description => $desc,
Status => $strAcctControl,
LastPwdChange => $strpwdLS
);
} else {
$group = $line;
chomp($desc = <GROUPS>);
chomp($group2 = <GROUPS>);
&debug("$group\n$desc\n$group\n");
}
}
Use Net::Ldap to search AD server. It is fast and it is portable. It is possible to search AD server from other hosts, even from linux. It is a fast and mature module.
You could also do some debug, using Data::Dumper.
use Data::Dumper;
...
print Dumper($strpwdLS);
I found this thread: http://code.activestate.com/lists/pdk/3876/
# Calculate password age in days
my $PWage;
my $LastPW = $item->{pwdLastSet};
my $fRef = ref ($LastPW);
my ($Hval, $Lval);
if ($fRef eq 'Win32::OLE' )
{
$Hval = $LastPW->HighPart;
$Lval = $LastPW->LowPart;
my $Factor = 10000000; # convert to seconds
my $uPval = pack("II",$Lval,$Hval);
my ($bVp, $aVp) = unpack("LL", $uPval);
$uPval = ($aVp*2**32+$bVp)/$Factor;
if ($uPval != 0)
{
$uPval -= 134774*86400; #Adjust for perl time!
my $EpochSeconds = time;
$PWage = ($EpochSeconds - int($uPval))/(60*60*24) ;
$PWage =~ s/\..*$//;
}
}
According to the documentation, you should use the getNumberByUniqueId() method to retrieve the message ID when moving/deleting emails. However, I still seem to get an exception appearing part way through processing a folder: "the single id was not found in response".
The code that is used goes along the lines of:
try {
$emailAddresses = array ();
$invalidAddresses = array ();
$errors = array();
$emailValidator = new Zend_Validate_EmailAddress ();
$trimFilter = new Zend_Filter_StringTrim ();
$mail = new Zend_Mail_Storage_Imap (...);
$mail->selectFolder ( '/Unsubscribe' );
echo 'There are ' . $mail->countMessages () . " messages to process\n";
foreach ( $mail as $messageId => $message ) {
try {
$mail->noop ();
$recipientMatch = $trimFilter->filter ( str_ireplace ( 'REMOVE ', '', $message->subject ) );
if (! substr_count ( $recipientMatch, '#' )) {
// Try the sender if the subject line doesn't have an address in
$matches = array ();
$from = $message->getHeader ( 'from' );
preg_match ( '/<(.+#.+)>/', $from, $matches );
if (sizeof ( $matches ) == 2) {
$recipientMatch = $matches [1];
} else {
$recipientMatch = $from;
}
}
if (! $emailValidator->isValid ( $recipientMatch )) {
$invalidAddresses [] = $recipientMatch;
continue;
}
$emailAddresses [] = $recipientMatch;
$messageUniqueId = $mail->getUniqueId ( $messageId );
$mail->moveMessage ( $mail->getNumberByUniqueId ( $messageUniqueId ), '/Unsubscribe/done' );
} catch ( Exception $e ) {
$errors[] = array($recipientMatch , $e);
}
}
} catch ( Zend_Mail_Storage_Exception $e ) {
echo "There was a problem processing the mail account\n", $e->getMessage ();
} catch ( Exception $e ) {
echo "There was an unmatched exception\n", $e->getMessage ();
}
Any ideas why the exception is being thrown (Zend Framework v1.10.8)?
The stack trace for the exception is:
#0 /usr/share/php/libzend-framework-php/Zend/Mail/Storage/Imap.php(163): Zend_Mail_Protocol_Imap->fetch(Array, 4)
#1 /usr/share/php/libzend-framework-php/Zend/Mail/Storage/Abstract.php(307): Zend_Mail_Storage_Imap->getMessage(4)
#2 /tmp/unsubscribe.php(29): Zend_Mail_Storage_Abstract->current()
#3 /tmp/dummy.php(1): include('/tmp/unsubscribe.php')
#4 {main}
The content of the Array used in Zend_Mail_Protocol_Imap->fetch() is:
Array(
0 => 'FLAGS',
1 => 'RFC822.HEADER'
)
You sholud not use this kind of loop. With this loop $messageId is outdated as soon as you delete a single message. With the next cycle the $messageId would 'point' to the wrong message or even no message (like Index-Out-Of-Bounce). That's why you've got the error message.
Solution: collect all relevant unique ids first into an array, then loop through this array and call moveMessage - with the up-to-date id that you get from getNumberByUniqueId!
I hope I'm not wrong, but I think moveMessage($id, $folder) should be moveMessage($index, $folder). This is more accurate. But correct me if this is wrong.
as it mentioned before... in case if you've got an error: "the single id was not found in response" means that the message sequence changed in expunge process, so when you save all IDs of all messages and try to iterate you have this error, because some messages was deleted in previous, please check: http://framework.zend.com/issues/browse/ZF-5655
You can use "while" for get ACTUAL collection of ids on every iteration, like this:
while($next_id = $gmail->getUniqueId()) {
// move message to label folder "My_archive_folder"
$gmail->moveMessage($next_id, 'My_archive_folder');
}