I am trying to create a script to generate a csv file with the results of some ldap queries using Net::LDAP but I'm having troubles skipping incomplete lines if one element of the #attributes array is blank.
my #attributes = ('cn', 'mail', 'telephoneNumber');
So for example, if a user has no mail listed, or no telephoneNumber listed, then it should skip the hold field instead of returning:
"Foo Bar",, # this line should be skipped since there is no mail nor telephone
"Bar Foo","bar#foo.com", # this line should be skipped too, no number listed
"John Dever","john_dever#google.com","12345657" # this one is fine, has all values
My loop right now is looking like this:
# Now dump all found entries
while (my $entry = $mesg->shift_entry()){
# Retrieve each fields value and print it
# if attr is multivalued, separate each value
my $current_line = ""; # prepare fresh line
foreach my $a (#attributes) {
if ($entry->exists($a)) {
my $attr = $entry->get_value($a, 'asref' => 1);
my #values = #$attr;
my $val_str = "";
if (!$singleval) {
# retrieve all values and separate them via $mvsep
foreach my $val (#values) {
if ($val eq "") { print "empty"; }
$val_str = "$val_str$val$mvsep"; # add all values to field
}
$val_str =~ s/\Q$mvsep\E$//; # eat last MV-Separator
} else {
$val_str = shift(#values); # user wants only the first value
}
$current_line .= $fieldquot.$val_str.$fieldquot; # add field data to current line
}
$current_line .= $fieldsep; # close field and add to current line
}
$current_line =~ s/\Q$fieldsep\E$//; # eat last $fieldsep
print "$current_line\n"; # print line
}
I have tried code like :
if ($attr == "") { next; }
if (length($attr) == 0) { next; }
and several others without any luck. I also tried simple if () { print "isempty"; } debug tests and its not working. Im not exacly sure how could I do this.
I appreciate any help or pointers you could give me on what am I doing wrong.
Thanks a lot in advance for your help.
UPDATE:
Per chaos request:
my $singleval = 0;
A sample run for this program would return:
Jonathan Hill,Johnathan_Hill#example.com,7883
John Williams,John_Williams#example.com,3453
Template OAP,,
Test Account,,
Template Contracts,,
So what I want to do is to skip all the lines that are missing a field, either email or extension number.
Label your while loop:
Record: while (my $entry = $mesg->shift_entry()){
and use:
next Record;
Your problem is that your next is associated with your foreach. Using the label avoids that.
By the way, $attr == '', though it will work in this case, is bad logic; in perl, == is a numeric comparison. String comparison would be $attr eq ''. Though I'd just use next Record unless $attr.
Related
I know this topic has been covered but other posts usually has static hashes and arrays and the don't show how to load the hashes and arrays.
I am trying to process a music library. I have a hash with album name and an array of hashes that contain track no, song title and artist. This is loaded from an XML file generated by iTunes.
the pared down code follows:
use strict;
use warnings;
use utf8;
use feature 'unicode_strings';
use feature qw( say );
use XML::LibXML qw( );
use URI::Escape;
my $source = "Library.xml";
binmode STDOUT, ":utf8";
# load the xml doc
my $doc = XML::LibXML->load_xml( location => $source )
or warn $! ? "Error loading XML file: $source $!"
: "Exit status $?";
my %hCompilations;
my %track;
# extract xml fields
my #album_nodes = $doc->findnodes('/plist/dict/dict/dict');
for my $album_idx (0..$#album_nodes) {
my $album_node = $album_nodes[$album_idx];
my $trackName = $album_node->findvalue('key[text()="Name"]/following-sibling::*[position()=1]');
my $artist = $album_node->findvalue('key[text()="Artist"]/following-sibling::*[position()=1]');
my $album = $album_node->findvalue('key[text()="Album"]/following-sibling::*[position()=1]');
my $compilation = $album_node->exists('key[text()="Compilation"]');
# I only want compilations
if( ! $compilation ) { next; }
%track = (
trackName => $trackName,
trackArtist => $artist,
);
push #{$hCompilations{$album}} , %track;
}
#loop through each album access the album name field and get what should be the array of tracks
foreach my $albumName ( sort keys %hCompilations ) {
print "$albumName\n";
my #trackRecs = #{$hCompilations{$albumName}};
# how do I loop through the trackrecs?
}
This line isn't doing what you think it is:
push #{$hCompilations{$album}} , %track;
This will unwrap your hash into a list of key/value pairs and will push each of those individually onto your array. What you want is to push a reference to your hash onto the array.
You could do that by creating a new copy of the hash:
push #{$hCompilations{$album}} , { %track };
But that takes an unnecessary copy of the hash - which will have an effect on your program's performance. A better idea is to move the declaration of that variable (my %track) inside the loop (so you get a new variable each time round the loop) and then just push a reference to the hash onto your array.
push #{$hCompilations{$album}} , \%track;
You already have the code to get the array of tracks, so iterating across that array is simple.
my #trackRecs = #{$hCompilations{$albumName}};
foreach my $track (#trackRecs) {
print "$track->{trackName}/$track->{trackArtist}\n";
}
Note that you don't need the intermediate array:
foreach my $track (#{$hCompilations{$albumName}}) {
print "$track->{trackName}/$track->{trackArtist}\n";
}
first of all you want to push the hash as a single element, so instead of
push #{$hCompilations{$album}} , %track;
use
push #{$hCompilations{$album}} , {%track};
in the loop you can access the tracks with:
foreach my $albumName ( sort keys %hCompilations ) {
print "$albumName\n";
my #trackRecs = #{$hCompilations{$albumName}};
# how do I loop through the trackrecs?
foreach my $track (#trackRecs) {
print $track->{trackName} . "/" . $track->{trackArtist} . "\n";
}
}
I am using a 3rd party shopping cart solution that runs on a server (SellerDeck). I have some code that runs on the server to format a shopping basket with basic product data (quantity, price, name). I need to find some more data which I think is held in 2 arrays of hashes. I dont know what is contained in these 2 arrays so I would like to convert the array to a string and output via the existing code that puts it in a cookie on the client which I can then view. The 2 arrays are $pCartItem and $pProduct (see code at the bottom for how they are used).
The string $cartStr (bottom of the code) is output onto the client in a cookie by another part of the code.
I would like to covert the 2 arrays into 2 strings which can be concatenated onto $cartStr. I can then read the contents on my local pc (client). My issue is I am very unfamiliar with perl and know how to do the conversion.
I tried adding :
my $MiniCrtS=" ";
my $MiniCartElmt;
foreach $MiniCartElmt (#{$pProduct}) {
$MiniCrtS=$MiniCrtS . $MiniCartElmt;
}
and then changed the $cartStr from:
HTML::Entities::encode(substr($pProduct->{'NAME'},0,$abrv))
to:
HTML::Entities::encode(substr($MiniCrtS,0,$abrv))
but this change makes the code crash when run.
Any ideas on what I am doing wrong or an alternative to find out the data in the arrays?
Many thanks Tony
The relevant code is:
sub miniCart
{
use HTML::Entities ();
my $Self = shift;
my $abrv=12; # number of characters to abbreviate item name
my $defaultCur="£"; # currency symbol to include
my $cartStr="ss=" . $::g_sSearchScript . "cur=" . $defaultCur;
my $pCartItem;
foreach $pCartItem (#{$Self->{_CartList}})
{
my ($Status, $Message, $pProduct) = GetProduct($pCartItem->{'PRODUCT_REFERENCE'}, $pCartItem->{'SID'});
if ($Status == $::FAILURE)
{
return ($Status, $Message, []);
}
elsif ($Status == $::NOTFOUND)
{
next;
}
my #Prices = $Self->GetCartItemPrice($pCartItem);
$cartStr=$cartStr . "&!" . $pCartItem->{'QUANTITY'} . "x" . HTML::Entities::encode($pCartItem->{'PRODUCT_REFERENCE'}) . ">" . HTML::Entities::encode(substr($pProduct->{'NAME'},0,$abrv)) . ">" . $Prices[2]/100;
}
return $cartStr;
}
To get a dump of a data structure, you can use Data::Dumper.
I'd use it as follows:
use Data::Dumper qw( );
sub dumper {
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Sortkeys = 1;
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Useqq = 1;
return Data::Dumper::Dumper($_[0]);
}
warn("pProduct: " . dumper($pProduct));
This will log it the string produced to the web server's error log, but you could also return it in a cookie if that's what you really want.
Again, a whole day and I am stuck again.
I need to use an array of words or var that contains forbidden words that cannot appear in an email address.
Either:
$baddies = 'smtp mailer sysop';
or
#baddies = qw(smtp mailer sysop);
or
#baddies = qw/smtp mailer sysop/;
There are more bad words in the array too, about two dozen.
I am not running the latest version of perl so ~~ and so on are not supported.
I have a loop going on that sends the bands schedule out.
In that loop I need to check to see if the email contains any of those words.
I realize there may be some good emails that contain a match but, that is fine.
I have tried literally dozens of examples after I gave up trying to figure it out.
Latest was:
####FYI## $uaddress is from the foreach $uaddress(#addresses){ loop.
my %params = map { $uaddress => 1 } #baddies;
if(exists($params{$uaddress})) {
print "yep, it's there"; #for testing
push(#failed,"$uaddress is restricted<br />");
But, everything I tried just does not do what I need.
I even tried =~ and so on.
I AM REALLY feeling stupid about now..
I need another lesson here folks.. Thanks in advance.
Update: I also tried:
$baddies = 'smtp mailer sysop';
my #baddies = split / /, $baddies;
# iterate through the array
foreach (#baddies) {
if($_ =~ $uaddress) #I also reversed that {
print qq~$uaddress contains $_~;
}
}
Through trial, error and dumb luck, I haphazardly got this below to work:
foreach $uaddress(#addressList) {
$uaddress =~ s/\s//g;
#baddies = qw(smtp mailer sysop);
my #failed;
foreach (#baddies) {
if($uaddress =~ m/$_/i) {
push(#failed,"$uaddress is restricted because it found \"$_\" in the address<br />");
}
}
##stuff happens with emails that passed like Email::Verify
}
Let me be specific to my problem instead of generalizing it and confusing the audience. In my code I have set of network addresses (members of object-group actually) stored in individual arrays. I would like to compare whether Group A is a subset of Group B.
I am using Net::IP module to parse the IP addresses and use "overlaps" sub-routine to determine if an element (could be individual IP or a subnet) is a superset of another element.
The challenge I am facing is in returning success status only if each element of Group A, belongs to any one element of Group B.
Here is a way I thought of and proceeding to try to code it likewise:
$status = "match";
foreach $ip (#group_a) {
if a_in_b($ip,#group_b) #this sub-routine would be similar but with different comparison function
{
next;
}
else
{
$status = "no match";
last;}
}
Please suggest me if there is a better way to do it, would love to pick up new techniques. The above technique doesn't look sound at all! As I was searching for for some solutions, some references seem to suggest as if I could try using the smart match operator and overload it. But overloading is beyond my level of sophistication in perl, so kindly help!
EDIT:
Updated my code as per suggestion. Here is the working version (still need to add bits and pieces for error catching)
use Net::IP;
use strict;
use warnings;
my #subnet = ("10.1.128.0/24","10.1.129.0/24","10.1.130.0/24","10.1.108.4");
my #net = ("10.1.128.0/21","10.1.108.0/22");
sub array_subset {
my ($x, $y) = #_;
a_in_b ($_, #$y) or return '' foreach #$x;
return 1;
};
sub a_in_b {
my $node1 = shift(#_);
my #ip_list = #_;
for my $node2 (#ip_list) {
print $node2, "\n";
my $ip1 = new Net::IP ($node1) || die;
my $ip2 = new Net::IP ($node2) || die;
print "$node1 $node2 \n";
if ($ip1->overlaps($ip2)==$IP_A_IN_B_OVERLAP) {
return 1;
}
}
return "";
}
if (array_subset(\#subnet, \#net)) {
print "Matches";
}else
{
print "Doesn't match"
}
Overloading ~~ is a bit of overkill. I would suggest using List::MoreUtils:
use List::MoreUtils qw/all/;
if (all { a_in_b($_, #bignet) } #smallnet) {
# do something
};
Or just rewrite your own code as a sub, and in a more perlish way:
sub array_subset {
my ($x, $y) = #_;
a_in_b ($_, #$y) or return '' foreach #$x;
return 1;
};
# somewhere in the code
if (array_subset(\#subnet, \#net)) {
# do something
};
I have an array of hash references. The hashes contain 2 keys, USER and PAGES. The goal here is to go through the array of hash references and keep a running total of the pages that the user printed on a printer (this comes from the event logs). I pulled the data from an Excel spreadsheet and used regexes to pull the username and pages. There are 182 rows in the spreadsheet and each row contains a username and the number of pages they printed on that job. Currently the script can print each print job (all 182) with the username and the pages they printed but I want to consolidate this down so it will show: username 266 (i.e. just show the username once, and the total number of pages they printed for the whole spreadsheet.
Here is my attempt at going through the array of hash references, seeing if the user already exists and if so, += the number of pages for that user into a new array of hash references (a smaller one). If not, then add the user to the new hash ref array:
my $criteria = "USER";
my #sorted_users = sort { $a->{$criteria} cmp $b->{$criteria} } #user_array_of_hash_refs;
my #hash_ref_arr;
my $hash_ref = \#hash_ref_arr;
foreach my $index (#sorted_users)
{
my %hash = (USER=>"",PAGES=>"");
if(exists $index{$index->{USER}})
{
$hash{PAGES}+=$index->{PAGES};
}
else
{
$hash{USER}=$index->{USER};
$hash{PAGES}=$index->{PAGES};
}
push(#hash_ref_arr,{%hash});
}
But it gives me an error:
Global symbol "%index" requires explicit package name at ...
Maybe my logic isn't the best on this. Should I use arrays instead? It seems as though a hash is the best thing here, given the nature of my data. I just don't know how to go about slimming the array of hash refs down to just get a username and the total pages they printed (I know I seem redundant but I'm just trying to be clear). Thank you.
my %totals;
$totals{$_->{USER}} += $_->{PAGES} for #user_array_of_hash_refs;
And then, to get the data out:
print "$_ : $totals{$_}\n" for keys %totals;
You could sort by usage too:
print "$_ : $totals{$_}\n" for sort { $totals{$a} <=> $totals{$b} } keys %totals;
As mkb mentioned, the error is in the following line:
if(exists $index{$index->{USER}})
However, after reading your code, your logic is faulty. Simply correcting the syntax error will not provide your desired results.
I would recommend skipping the use of temporary hash within the loop. Just work with the a results hash directly.
For example:
#!/usr/bin/perl
use strict;
use warnings;
my #test_data = (
{ USER => "tom", PAGES => "5" },
{ USER => "mary", PAGES => "2" },
{ USER => "jane", PAGES => "3" },
{ USER => "tom", PAGES => "3" }
);
my $criteria = "USER";
my #sorted_users = sort { $a->{$criteria} cmp $b->{$criteria} } #test_data;
my %totals;
for my $index (#sorted_users) {
if (not exists $totals{$index->{USER}}) {
# initialize total for this user
$totals{$index->{USER}} = 0;
}
# add to user's running total
$totals{$index->{USER}} += $index->{PAGES}
}
print "$_: $totals{$_}\n" for keys %totals;
This produces the following output:
$ ./test.pl
jane: 3
tom: 8
mary: 2
The error comes from this line:
if(exists $index{$index->{USER}})
The $ sigil in Perl 5 with {} after the name means that you are getting a scalar value out of a hash. There is no hash declared by the name %index. I think that you probably just need to add a -> operator so the problem line becomes:
if(exists $index->{$index->{USER}})
but not having the data makes me unsure.
Also, good on you for using use strict or you would be instantiating the %index hash silently and wondering why your results didn't make any sense.
my %total;
for my $name_pages_pair (#sorted_users) {
$total{$name_pages_pair->{USER}} += $name_pages_pair->{PAGES};
}
for my $username (sort keys %total) {
printf "%20s %6u\n", $username, $total{$username};
}