I am not understanding how to use Data::Dumper even after reading the Perl doc and looking at other scripts in git. I see lots of examples online dealing with hashes, but I didn't think that quite fit with what I need to do.
I am creating a script to send emails to managers or teams regarding terminated employees. I was told to add print Dumper $email to my code so that when --dry_run option is used, we could see on the terminal a printout of what the email would look like. --dry_run would also ensure that the email isn't actually sent. When I run perl <script> --dry_run, nothing happens. Maybe I need to do something along the lines of $d = Data::Dumper->new(?
Here is a snippet of my code:
#!/usr/bin/perl
use strict;
use warnings;
use NIE::Email;
use Data::Dumper;
use List::Util qw(any);
use Getopt::Long;
Getopt::Long::Configure qw(gnu_getopt);
my ($qa, $verbose, $dry_run, $help, $dbh);
GetOptions(
'qa' => \$qa,
'verbose|v' => \$verbose,
'dry_run' => \$dry_run,
'help|h' => \$help
);
#Generate email here
sub mail_func {
print "Prepare email\n" if $verbose;
my $n = shift; #user
my $i = shift; #ips
my $t = shift; #testnets
my $m = shift; #managers (multiple if owner is undef)
my #to_list; # send to field
foreach my $value (values %{$t}) {
if ($value ne 'lab#abc.com') { #don't send this email to lab#
if (any { $value eq $_ } #to_list) { #check not already listed
next;
}
else { push(#to_list, $value); }
}
}
foreach my $key (keys %{$m}) {
if ($key ne 'def') {
if (any { $key eq $_ } #to_list) {
next;
}
else { push(#to_list, $key . '#abc.com'); }
}
}
my #body;
while (my ($key, $value) = each %{$i}) {
my $b = "IP " . $key . " : Testnet " . $value . "\n";
push(#body, $b);
}
my $sub1 = "Ownership needed!";
my $sub2 = "Ownership needed script special case";
my $email;
#Email testnet group (if not lab) as well as manager of term employee
if (#to_list) {
$email = NIE::Email->new(
From => 'do-not-reply#abc.com',
To => join(',', #to_list),
'Reply-to' => 'def#abc.com',
Subject => $sub1,
);
$email->data(
"Good Day, \n\n The below machines need claimed as their previous"
. " owner, $n, is showing up as no longer with the company. \n"
. "Please visit website to change"
. " ownership of these machhines. \n\n"
. "#body \n\n"
. "If you have already requested an ownership change for these"
. " machines, please disregard this message."
. "\n\n Thank you \n -Lab team \n\n"
. "This script is under active development and could contain"
. " bugs, so please speak up if you have doubts or something "
. "looks strange."
. "\n Script name: lab_ownership_needed_email");
if ($dry_run) {print Dumper($email);}
else {$email->send();}
}
Any help in understanding how to use this for my purpose would be greatly appreciated. Thank you.
Reverted to original, re-added in code, re-ran the script, and it works.
The above code is correct as is.
Thanks to simbabque who stated the code looked correct in the first place.
Related
I am building a signup form with Perl (using the CGI module) and a recaptcha. The form works fine and submits the data to a SQL database. However, when I create another user with the form, the data entered into the database is the same as the first user. I am retrieving the form data in my verification page using my $var = $cgi->param('param_name'); Do I need to clear the params, or is it something else. (I tried $cgi->delete_all(); but that didn't seem to do anything)
Form Verification Code: (It is literally a prototype, so security has not been addressed yet)
my $challenge = $q->param('recaptcha_challenge_field');
my $response = $q->param('recaptcha_response_field');
my $username = $q->param('Username');
my $password = $q->param('Password');
my $name = $q->param('Name');
my $email = $q->param('Username');
my $security = $q->param('Security');
my $answer = $q->param('Answer');
my $permissions = 1;
# Verify submission
my $result = $c->check_answer(
"my_private_key", $ENV{'REMOTE_ADDR'},
$challenge, $response
);
if ( $result->{is_valid} ) {
insert_new_user();
print $q->redirect('cgi-bin/admin/text_campaign.pl');
}
else {
# Error
print $q->redirect('login.pl?crc=false');
}
###############################################################################
# Sub Routines #
###############################################################################
sub insert_new_user
{
my $sql = "INSERT INTO users (u_username, u_password, u_realname, u_email, u_security_question, u_security_answer, PRIVILEGES_idPRIVILEGES)
VALUES(?, ?, ?, ?, ?, ?, ?) ";
my $sth=$dbh->prepare($sql);
$sth->execute($username, $password, $name, $email, $security, $answer, $permissions);
$sth->finish();
return;
}
Yes, that's the way it normally works. Look into the -nosticky "pragma" in the documentation
http://perldoc.perl.org/CGI.html#PRAGMAS
or the delete_all() function.
--- EDIT ---
I played a little with a modified form of the sample that is in CGI.pm's documentation. Including it here for ease of reference, and because i changed it a little.
#!/usr/bin/perl
use CGI qw/-nosticky :standard/;
print header;
print start_html("Example CGI.pm Form");
print "<h1> Example CGI.pm Form</h1>\n";
do_work();
print_prompt();
print_tail();
print end_html;
sub print_prompt {
print "<hr>\n";
print start_form;
print "<em>What's your name?</em><br>";
print textfield('name');
print checkbox('Not my real name');
print "<p><em>Where can you find English Sparrows?</em><br>";
print checkbox_group(
-name=>'Sparrow locations',
-values=>[England,France,Spain,Asia,Hoboken],
-linebreak=>'yes',
-defaults=>[England,Asia]);
print "<p><em>How far can they fly?</em><br>",
radio_group(
-name=>'how far',
-values=>['10 ft','1 mile','10 miles','real far'],
-default=>'1 mile');
print "<p><em>What's your favorite color?</em> ";
print popup_menu(-name=>'Color',
-values=>['black','brown','red','yellow'],
-default=>'red');
print hidden('Reference','Monty Python and the Holy Grail');
print "<p><em>What have you got there?</em><br>";
print scrolling_list(
-name=>'possessions',
-values=>['A Coconut','A Grail','An Icon',
'A Sword','A Ticket'],
-size=>5,
-multiple=>'true');
print "<p><em>Any parting comments?</em><br>";
print textarea(-name=>'Comments',
-rows=>10,
-columns=>50);
print "<p>",reset;
print submit('Action','Shout');
print submit('Action','Scream');
print end_form;
print "<hr>\n";
}
sub do_work {
print "<h2>Here are the current settings in this form</h2>";
for my $key (param) {
print "<strong>$key</strong> -> ";
my #values = param($key);
print join(", ",#values),"<br>\n";
}
}
sub print_tail {
print <<END;
<hr>
<address>Lincoln D. Stein</address><br>
Home Page
END
}
Left as is, this script exhibits the behavior we are discussing. The use of -nosticky doesn't seem to have helped.
However, if i add Delete_all after do_work and before print_prompt(), like so:
print header;
print start_html("Example CGI.pm Form");
print "<h1> Example CGI.pm Form</h1>\n";
do_work();
Delete_all();
print_prompt();
print_tail();
print end_html;
Then the defaults are not prepopulated.
I hope this helps.
I'm working on a dispatching script. It takes a string with a command, does some cooking to it, and then parses it. But I can't grab a hold into the referencing:
Use::strict;
Use:warnings;
my($contexto, $cmd, $target, $ultpos, #params);
my $do = "echo5 sample string that says stuff ";
$target = "";
$cmd = "";
$_ = "";
# I do some cumbersome string parsing to get the array with
# the exploded string and then call parsear(#command)
sub parsear {
my %operations = (
'echo' => \&echo,
'status' => \&status,
'echo5' => \&echo5,
);
my $op = $_[0];
if ($operations{$op}){
$operations{$op}->(#_);
print "it exists\n";
}
else{
print "incorrect command.\n";
}
}
sub status {
print "correct status.\n";
}
sub echo {
shift(#_);
print join(' ',#_) . "\n";
}
sub echo5 {
shift(#_);
print join(' ',#_) . "\n" x 5;
}
I don't really know what the problem is. If the sub does not exist, it never says "incorrect command", and if I call for example "echo5 hello" it should print out:
hello
hello
hello
hello
hello
But it does nothing.
And when I call echo, it works as expected. What is the explanation?
Note: I'm on the latest version of Strawberry Perl
use strict; # 'use' is a keyword
use warnings;
# All these variables are not needed
sub parsear { # Learn to indent correctly
my %operations = (
'echo' => \&echo,
'status' => \&status,
'echo5' => \&echo5,
);
my $op = shift; # take first element off #_
if ($operations{$op}) {
print "$op exists\n"; # Make your status message useful
$operations{$op}->(#_);
} else {
print "incorrect command: $op\n"; # And your error message
}
}
sub status {
print "correct status.\n";
}
sub echo {
# shift(#_); # This is no longer needed, and now echo can be used as a
# normal subroutine as well as a dispatch target
print join(' ',#_) . "\n";
}
sub echo5 {
# shift(#_); # This is no longer needed
print +(join(' ',#_) . "\n") x 5; # Parentheses are needed since x binds tightly
}
Then running:
parsear 'status';
parsear 'echo', 'hello';
parsear 'echo5', 'hello';
parsear 'an error';
results in:
status exists
correct status.
echo exists
hello
echo5 exists
hello
hello
hello
hello
hello
incorrect command: an error
I am not sure what "cumbersome string parsing" you are doing since you did not include it, but if you are parsing a string like
my $do = "echo5 sample string that says stuff ";
where the command is the first word, and the arguments are the rest, you can either split everything:
parsear split /\s+/, $do;
Or use a regex to cut the first word off:
my ($cmd, $arg) = $do =~ /^(\w+)\s*(.*)/;
parsear $cmd => $arg;
You don’t even need the variables:
parsear $do =~ /^(\w+)\s*(.*)/;
Finally, the echo5 subroutine is a bit more complicated than it needs to be. It could be written as:
sub echo5 {
print "#_\n" x 5; # "#_" means join($", #_) and $" defaults to ' '
}
The x command binds differently from how you were expecting; you probably wanted:
print ((join(' ', #_) . "\n") x 5);
Both extra sets of parentheses seemed to be necessary.
I need to establish this single task with Irssi Perl script. I have my own channel and I want to sent msg directly to that channel in certain scenarios.
My experience with Perl is quite limited so I haven't got this one. I am confused how to manage different chatnets and channels in Irssi Perl scripting. So how I can send message for example channel #testchan#Quakenet for example?
Test one:
server->command("^MSG $info{'#testchan'} $info{'Test message.'}");
Test two (tuto about scripting):
sub away_describe_pub_channels {
my($net, $channel) = #_;
my ($text) = #_;
my $c = Irssi::server_find_chatnet("QuakeNet")->channel_find("testchan");
$c->command("DESCRIBE $channel $text")
}
here is an example is used for a bot :)
#==========================BEGINNING OF PARMS======================================
#name of the channels where this feature will be used
my #channels = ("foo","bar");
#the public commands
#help
my $cmd_help = '!help';
#new ticket
my $cmd_newticket = "!stack";
my %url_newticket = ( 'foo'=>{url=>"http://stackoverflow.com/questions/ask"},
'bar'=>{url=>"http://https://github.com/repo/project/issues/new"}
sub bootstrap {
my ($server, $msg, $nick, $address, $target) = #_;
#lowercase of the channel name in case this one will be registered in camelCase ;)
$target = lc $target;
foreach my $channel (#channels) {
if ( $target eq "#".$channel) {
#split the line first peace the command second the rest
my ($cmd,$line) = split / /,$msg,2;
if ($cmd =~ $cmd_help) {
$server->command("MSG ". $nick ." Here are the available commands : !stack");
} elsif ($cmd eq $cmd_newticket) {
my $h = $url_newticket{$channel};
$server->command("MSG $target submit an issue/a ticket $h->{'url'}");
}
}
}
}
#let's add the sub as a signal and let's play
Irssi::signal_add_last('message public', 'bootstrap');
Hope this could help
This one makes no sense to me. I have these two subroutines.
sub load_config_file {
if (#_ eq '') {
die RED . "No configuration file defined" . RESET . "\n";
} else {
if (! -e "#_") {
die RED . "#_ not found!" . RESET . "\n";
} else {
if (`cat #_` eq '') {
die RED . "$config_file_path is an empty file!" . RESET . "\n\n";
} else {
print "Configuration file:" . GREEN . "#_" . RESET . "\n";
my $xml_obj = XML::Simple->new();
my $config_xml = $xml_obj->XMLin("#_", SuppressEmpty => 1);
%config_file = %$config_xml;
}
}
}
} # End load_config_file
sub load_guest_os_file {
if (#_ eq '') {
die RED . "No guest operating system file defined" . RESET . "\n";
} else {
if (! -e "#_") {
die RED . "#_ not found!" . RESET . "\n";
} else {
if (`cat #_` eq '') {
die RED . "#_ is an empty file!" . RESET . "\n\n";
} else {
print "Guest OS file:" . GREEN . "#_" . RESET . "\n";
my $xml_obj = XML::Simple->new();
my $guest_os_xml = $xml_obj->XMLin("#_", SuppressEmpty => 1);
%guest_os_file = %$guest_os_xml;
}
}
}
} # End load_guest_os_file
Their purpose is to load a specific config file needed for my script. The first one, load_config_file, works perfect. But when I move onto the second one, load_guest_os_file, I get these errors from Perl:
Use of uninitialized value $_[0] in join or string at analyze.pl line 146.
Use of uninitialized value $_[0] in join or string at analyze.pl line 148.
Line 146 in my script is
if (! -e "#_") {
and line 148 is
die RED . "#_ not found!" . RESET . "\n";
What am I missing? When I call the subroutine thus:
load_config_file($config_file_path)
load_guest_os_file($guest_os_file_path)
… the values assigned to those two variables are
my $config_file_path = './config.xml'
and
my $guest_os_file_path = './guest_os.xml'
Edit: I should also add the values for the two variables coming from the command line arguments processed by Getopt::Long. If no value is assigned, the variable is just "declared", I think that's the term. I do not assign a value to it, it's just my $config_file_path; and my $guest_os_file_path;.
Update
Here is the code from the beginning of the script.
#!/usr/bin/perl
use strict;
use warnings;
# Modules to load
use Getopt::Long;
use Term::ANSIColor qw(:constants);
use XML::Simple;
use Net::Ping;
use Net::OpenSSH;
use Data::Dumper;
# Script version
my $version = 'v0.6';
my (%config_file, %guest_os_file, %machines_xml, $ssh_obj);
my #selected_mode;
# Configuration file
my $config_file_path;
# Guest OS file
my $guest_os_file_path;
# Exclusion file
my $exclude_file_path;
# Disables snapshot capture
my $no_snapshots = 0;
my $logfile_path;
my $verbose = 0;
# Program modes
my %program_modes = (
analyze => \&analyze,
backup => \&backup,
restore => \&restore,
help => \&help,
);
GetOptions(
'c=s' => \$config_file_path,
'e=s' => \$exclude_file_path,
'g=s' => \$guest_os_file_path,
'l=s' => \$logfile_path,
'v' => \$verbose,
'x' => \$no_snapshots,
'a' => sub { push #selected_mode, "analyze" },
'b' => sub { push #selected_mode, "backup" },
'h' => sub { push #selected_mode, "help" },
'r' => sub { push #selected_mode, "restore" },
's' => sub { push #selected_mode, "setup" },
);
# Show the help menu if no program mode has been selected
if (#selected_mode == 0) {
help();
# Throw an error and show the help menu if too many modes are selected
} elsif (#selected_mode > 1) {
print RED . "Too many program modes specified" . RESET . "\n";
print "See help menu [-h] for further information\n";
# Run the selected program mode
} elsif (#selected_mode == 1) {
if ($selected_mode[0] eq 'help') {
help();
} else {
# Die unless user is root
die RED . "You must be have superuser permissions to run this script" . RESET . "\n" unless ($> == 0);
system "clear";
print "Solignis's VMware $selected_mode[0] script $version for ESX\\ESX(i) 4.0+\n";
load_config_file($config_file_path);
if ($selected_mode[0] eq 'analyze') {
load_guest_os_file($guest_os_file_path);
} else {
######
}
}
}
This will always be false:
if (#_ eq '') {
When empty, the array gives 0 in scalar context, not ''.
Just:
if ( ! #_ ) {
is sufficient to test if there was nothing passed.
But I think you actually mean to insure a defined value was passed:
if ( ! defined $_[0] ) {
To know why it $_[0] is undefined, we'd have to see the code from the declaration to where it is passed to the sub.
Some genereal pointers on your code:
Consider using elsif instead of the ever nesting else blocks.
If you have a bunch of error conditions you're filtering out, consider using statement modifier if/unless logic.
Consider using -z or -s to get your file size ( see http://perldoc.perl.org/functions/-X.html ).
Unpack #_ at the top of your subroutines.
Minimize use of global variables. Explicitly pass all data in and out of your subs.
Here's a cleaned up version of your first sub:
sub load_config_file {
my $config_file = shift;
die RED . "No configuration file defined" . RESET . "\n"
unless defined $config_file;
die RED . "$config_file not found!" . RESET . "\n"
unless -e $config_file;
die RED . "$config_file_path is an empty file!" . RESET . "\n\n"
if -z $config_file;
print "Configuration file:" . GREEN . "#_" . RESET . "\n";
my $xml_obj = XML::Simple->new();
my $config_xml = $xml_obj->XMLin("#_", SuppressEmpty => 1);
return $config_xml;
} # End load_config_file
BTW, I am not sure what you have going on with the REDs and RESETs in your die messages, but I have a feeling that it could be better achieved with an exception handler.
If you use the subs with only one value, you might as well copy that over to a variable, instead of using #_, like so:
sub load_guest_os_file {
my $path = shift;
The tests you are performing can be done better, and they do not need to be inside each other, since the only result is die:
$path || die RED . "No guest operating system file defined" . RESET . "\n";
-e $path || die RED . "$path not found!" . RESET . "\n";
-s $path || die RED . "$path is an empty file!" . RESET . "\n\n";
The -e check is not functionally necessary, as -s will fail also if the file is missing. It will give a better error, though.
Also, if you are using arguments to your function, it might be more consistent to not manipulate global variables with the sub, and instead give a return value, such as:
...
return %$config_xml;
}
%config_file = load_config_file($config_file_path);
In order to get the warnings mentioned above, the first parameter to subroutine load_guest_os_file has to be undefined (which is the default value after declaration).
From the source code you have shown, the only possibility I can see for this scenario to happen is that no valid option -g<path> was given, and so variable $guest_os_file_path is never assigned a value. Then subroutine load_guest_os_file would be called with an undefined value as its parameter like this
load_guest_os_file(undef)
and Perl would give these warnings.
I have used the module Mail::Webmail::Gmail to read the new messages in my Gmail account.
I have written the following code for this purpose:
use strict;
use warnings;
use Data::Dumper;
use Mail::Webmail::Gmail;
my $gmail = Mail::Webmail::Gmail->new(
username => 'username', password => 'password',
);
my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmail::FOLDERS{ 'INBOX' } );
foreach ( #{ $messages } ) {
if ( $_->{ 'new' } ) {
print "Subject: " . $_->{ 'subject' } . " / Blurb: " . $_->{ 'blurb' } . "\n";
}
}
But it didn't print anything.
Can anyone help me in this or suggest any other module for this?
Thanks in advance.
This is taken almost word from word from the Net::IMAP::Simple POD:
use strict;
use warnings;
# required modules
use Net::IMAP::Simple;
use Email::Simple;
use IO::Socket::SSL;
# fill in your details here
my $username = 'user#example.com';
my $password = 'secret';
my $mailhost = 'pop.gmail.com';
# Connect
my $imap = Net::IMAP::Simple->new(
$mailhost,
port => 993,
use_ssl => 1,
) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
# Log in
if ( !$imap->login( $username, $password ) ) {
print STDERR "Login failed: " . $imap->errstr . "\n";
exit(64);
}
# Look in the INBOX
my $nm = $imap->select('INBOX');
# How many messages are there?
my ($unseen, $recent, $num_messages) = $imap->status();
print "unseen: $unseen, recent: $recent, total: $num_messages\n\n";
## Iterate through unseen messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
if ( $imap->seen($i) ) {
next;
}
else {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject') );
}
}
# Disconnect
$imap->quit;
exit;
You can use the Mail::POP3Client module. It is used to get the message from the Gmail account.
Have you tried doing some error checking with after you try an operation
if ($gmail->error())
{
print $gmail->error_msg();
}
I found that when I do it it results in:
Error: Could not login with those
credentials - could not find final URL
Additionally, HTTP error: 200 OK
Error: Could not Login.
I believe it may be because this module was last updated in 2006 and gmail may have changed the way the logins work so it may no longer be able to access it.
What you could do if you don't just want to download new messages with pop3 is you can use
Net::IMAP::Simple to access a gmail account via IMAP