Multiple string parse to loop - perl

I currently have some code which returns a sites header content back:
#!/usr/bin/perl
use strict;
require IO::Socket;
my #header;
my $host = shift;
my $socket = new IO::Socket::INET(
PeerAddr => $host,
PeerPort => 80,
Proto => 'tcp') || die "Could not Connect $!\n";
print "Connected.\n";
print "Getting Header\n";
print $socket "GET / HTTP/1.0\n\n";
my $i = 0;
while (<$socket>) {
#header[$i] = $_;
$i++;
}
$i = 0;
print "--------------------------------------\n";
while ($i <= 8) {
print "#header[$i++]";
}
print "-------------------------------------\n";
print "Finished $host\n";
What I would like to do, is to be able to read from a file open (FILE, '<', shift); and then every IP in the file, to pass into a the header retrieve loop, which saves me from manually doing one by one.
What I mean by this is to have a file containing (example ips): 1.1.1.1 2.2.2.2 on each line and then parsing all of them through the get header function.

Replace
my #header;
my $host = shift;
...
with
while (<>) {
chomp( my $host = $_ );
my #header;
...
}

You would just open your file, read the contents into a list, then iterate over the list:
open my $fh, '<', $file or die "$!";
my #ips = <$fh>;
close $fh;
foreach my $ip ( #ips ) {
chomp $ip;
...
}

Related

How to read .csv file in Perl to get required fields only, perform some operation and write back the results to same file?

I have a CSV file which contains IP, Alive fields like below:
ip, alive
127.0.0.1, Yes
127.0.0.2, No
I want to ping each IP and if the ping is reachable then I need to put Yes in front of that IP in same CSV file.
I'm trying with below code, but stuck at reading and writing the same CSV file.
#!/usr/bin/perl
use strict;
use warnings;
use Net::Ping;
use Data::Dumper;
my $file = 'servers.csv';
my #filedata;
open(my $fh, '<', $file) or die "Can't read file '$file' [$!]\n";
while (my $line = <$fh>) {
chomp $line;
my #fields = split(/,/, $line);
push #filedata, \#fields;
}
print Dumper(#filedata);
my $p = Net::Ping->new();
if ($p->ping('127.0.0.1'))
{
print "\nYes\n";
}
My code for ping and reading file is working fine but I'm not much sure about loop through the data read from file and then ping and store the result back to CSV file.
Any help will be highly appreciated.
use Tie::Array::CSV qw();
tie my #file, 'Tie::Array::CSV', 'servers.csv';
for my $server (#file) {
next if 'ip' eq $server->[0]; # skip table header
my $ping_result = rand > 0.5 ? 'Yes' : 'No'; # fake ping
$server->[1] = $ping_result; # update file
}
I think this does what you want:
#!/usr/bin/perl
use strict;
use warnings;
use Net::Ping;
use Data::Dumper;
use File::Copy;
my $file = 'servers.csv';
my $fileOut = 'serversOut.csv';
my #filedata;
open(my $fh, '<', $file) or die "Can't read file '$file' [$!]\n";
open(my $fhOut, '>', $fileOut) or die "Can't read file '$fileOut' [$!]\n";
while (my $line = <$fh>) {
chomp $line;
my #fields = split(/,/, $line);
my $p = Net::Ping->new();
if($fields[0] eq 'ip') {
print "Header $fields[0]\n";
print $fhOut 'ping, ' . $line . "\n";
next;
}
if ($p->ping($fields[0])) {
print "Pinging $fields[0] - yes\n";
print $fhOut 'Yes, ' . $line . "\n";
}
else {
print "Pinging $fields[0] - no\n";
print $fhOut 'No, ' . $line . "\n";
}
}
close $fh;
close $fhOut;
move($fileOut, $file) or die "Can't move '$fileOut' file '$file' [$!]\n";

modification of script in perl

currently I have the following script
#!/usr/bin/env perl
use strict;
use warnings;
my %seen;
my $header = <> . <>;
print $header;
my $last_sequence_number = 0;
open( my $output, ">", "output.$last_sequence_number.out" ) or die $!;
print {$output} $header;
$seen{$last_sequence_number}++;
while (<>) {
my ($key) = split;
next unless $key =~ m/^\d+$/;
my $sequence_number = int( $key / 1000 );
if ( not $sequence_number == $last_sequence_number ) {
print "Opening new file for $sequence_number\n";
close($output);
open( $output, ">", "output.$sequence_number.out" ) or die $!;
print {$output} $header unless $seen{$sequence_number}++;
$last_sequence_number = $sequence_number;
}
print {$output} $_;
}
the script splits a file into other files with the pattern file 1 file 2 ... now I would need to pass to the script another parameter which allows to specify a prefix for the output so if this additional input is 1 then the output would be
1_file1,1_file2....and so on.. how could I do that?
I know that something like
use Getopt::Long;
could be used?
tried this
#!/usr/bin/env perl
use strict;
use warnings;
my %seen;
my $header = <> . <>;
print $header;
my ( $suffix, $filename ) = #ARGV;
open ( my $input, "<", $filename ) or die $!;
my $last_sequence_number = 0;
open( my $output, ">", "output.$last_sequence_number.out" ) or die $!;
print {$output} $header;
$seen{$last_sequence_number}++;
while (<$input>) {
my ($key) = split;
next unless $key =~ m/^\d+$/;
my $sequence_number = int( $key / 1000 );
if ( not $sequence_number == $last_sequence_number ) {
print "Opening new file for $sequence_number\n";
close($output);
open( $output, ">", "output.$sequence_number.out" ) or die $!;
print {$output} $header unless $seen{$sequence_number}++;
$last_sequence_number = $sequence_number;
}
print {$output} $_;
}
but that is not working. What is wrong?
I get
No such file or directory at ./spl.pl line 10, <> line 2.
after the header is printed.
As Sobrique says, your problem is the magical nature of <>. But I don't think that it's as hard to deal with as he thinks.
The point is that <> looks at the current value of #ARGV. So you can add other command line arguments as long as you ensure that you have removed them from #ARGV before you use <> for the first time.
So change your code so that it starts like this:
my %seen;
my $prefix = shift;
my $header = <> . <>;
You can then call your program like this:
$ your_program.pl prefix_goes_here list of file names...
Everything else should now work the same as it currently does, but you have your prefix stored away in $prefix so that you can use it in your print statements.
I hope that's what you wanted. Your question isn't particularly clear.
I would do something like this.
#!/usr/bin/env perl
use strict;
use warnings;
use autodie;
use Getopt::Long qw(:config bundling);
use Pod::Usage;
{
my $man = 0;
my $help = 0;
my $verbose = 0;
my $prefix = '';
my $suffix = '';
my $header_lines = 2;
my $bunch_size = 1000;
GetOptions(
'help|?' => \$help,
'man' => \$man,
'verbose|v+' => \$verbose,
'prefix|p=s' => \$prefix,
'suffix|s=s' => \$suffix,
'header|h=i' => \$header_lines,
'bunch|batch|bucket|b=i' => \$bunch_size
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -exitval => 0, -verbose => 2 ) if $man;
pod2usage(
-exitval => 3,
-message => "Headers lines can't be negative number"
) if $header_lines < 0;
pod2usage(
-exitval => 4,
-message => "Bunch size has to be positive"
) unless $bunch_size > 0;
my $header = '';
$header .= <> for 1 .. $header_lines;
my %seen;
my $current_output_number = -1;
sub key2output { int( shift() / $bunch_size ) }
sub set_output {
my $output_number = shift;
if ( $output_number != $current_output_number ) {
my $seen = $seen{$output_number}++;
printf STDOUT "Opening %sfile for %d\n", $seen ? '' : 'new ',
$output_number
if $verbose;
open my $fh, $seen ? '>>' : '>',
$prefix . $output_number . $suffix;
select $fh;
print $header unless $seen;
$current_output_number = $output_number;
}
}
}
while (<>) {
my ($key) = /^(\d+)\s/;
next unless defined $key;
set_output( key2output($key) );
print;
}
__END__
=head1 NAME
code.pl - splits file by first number by thousands
=head1 SYNOPSIS
code.pl [options] [file ...]
Options:
--help brief help message
--man full documentation
--prefix output filename prefix
--suffix outpit filename suffix
--header number of header lines (default: 2)
=head1 OPTIONS
=over 8
=item B<--help>
Print a brief help message and exits.
=item B<--man>
Prints the manual page and exits.
=back
=head1 DESCRIPTION
B<This program> will read the given input file(s) and do something
useful with the contents thereof.
=cut
Just finish documentation and you can ship it to your colleagues.
The problem you've got is that the diamond operator <> is a piece of special perl magic.
It takes 'all filenames on command line' opens them and processes them in order.
To do what you're trying to do:
my ( $suffix, $filename ) = #ARGV;
open ( my $input, "<", $filename ) or die $!;
Then you can change your while loop to:
while ( <$input> ) {
And modify the output filename according to your desires. The key different there is that it'll only take one filename at that point - first arg is suffix, second is name.
You could perhaps extend this with:
my ( $suffix, #names ) = #ARGV;
And then run a foreach loop:
foreach my $filename ( #names ) {
open .... #etc

How to encrypt and decrypt a specific column in a file by using Perl?

I have log file like below,
NAME ID LOCATION
aa 12 in
bb 13 freak
cc 14 test
I want to encrypt and as well as decrypt the field "LOCATION". How to do that by using any Encryption module in Perl ?
Since I'm new to Perl, help me .
Use Crypt::CBC
A sample script
#!/usr/bin/perl
use strict;
use Crypt::CBC;
unless (scalar #ARGV == 3) {
die "Usage: $0 encrypt|decrypt|en|de \$mysecretkey \$file_to_dencrypt";
}
my $type = shift #ARGV;
my $key = shift #ARGV;
my $file = shift #ARGV;
die "The first ARGV should be one of de, en, encrypt, decrypt" if ($type !~ /^(en|de)(crypt)?$/);
die "the file $file is not existence" unless (-f $file);
my $DEBUG = 1;
print "type is $type, key is $key, file is $file\n" if $DEBUG;
my $cipher = Crypt::CBC->new(
-key => $key,
-cipher => 'Blowfish'
);
local $/;
open(FH, $file) or die $!;
flock(FH, 2);
my $data = <FH>;
close(FH);
my ($save_data, $save_file);
if ($type =~ /^en(crypt)?$/) {
$save_data = $cipher->encrypt($data);
$save_file = $file . '.encrypt';
} else {
$save_data = $cipher->decrypt($data);
$save_file = $file . '.decrypt';
}
open(FH, '>', $save_file) or die $!;
print FH $save_data;
close(FH);
if (-e $save_file) {
print "$type file $file to $save_file OK\n";
} else {
print "failed without reason\n";
}

how to count the number of specific characters through each line from file?

I'm trying to count the number of 'N's in a FASTA file which is:
>Header
AGGTTGGNNNTNNGNNTNGN
>Header2
AGNNNNNNNGNNGNNGNNGN
so in the end I want to get the count of number of 'N's and each header is a read so I want to make a histogram so I would at the end output something like this:
# of N's # of Reads
0 300
1 240
etc...
so there are 300 sequences or reads that have 0 number of 'N's
use strict;
use warnings;
my $file = shift;
my $output_file = shift;
my $line;
my $sequence;
my $length;
my $char_N_count = 0;
my #array;
my $count = 0;
if (!defined ($output_file)) {
die "USAGE: Input FASTA file\n";
}
open (IFH, "$file") or die "Cannot open input file$!\n";
open (OFH, ">$output_file") or die "Cannot open output file $!\n";
while($line = <IFH>) {
chomp $line;
next if $line =~ /^>/;
$sequence = $line;
#array = split ('', $sequence);
foreach my $element (#array) {
if ($element eq 'N') {
$char_N_count++;
}
}
print "$char_N_count\n";
}
Try this. I changed a few things like using scalar file handles. There are many ways to do this in Perl, so some people will have other ideas. In this case I used an array which may have gaps in it - another option is to store results in a hash and key by the count.
Edit: Just realised I'm not using $output_file, because I have no idea what you want to do with it :) Just change the 'print' at the end to 'print $out_fh' if your intent is to write to it.
use strict;
use warnings;
my $file = shift;
my $output_file = shift;
if (!defined ($output_file)) {
die "USAGE: $0 <input_file> <output_file>\n";
}
open (my $in_fh, '<', $file) or die "Cannot open input file '$file': $!\n";
open (my $out_fh, '>', $output_file) or die "Cannot open output file '$output_file': $!\n";
my #results = ();
while (my $line = <$in_fh>) {
next if $line =~ /^>/;
my $num_n = ($line =~ tr/N//);
$results[$num_n]++;
}
print "# of N's\t# of Reads\n";
for (my $i = 0; $i < scalar(#results) ; $i++) {
unless (defined($results[$i])) {
$results[$i] = 0;
# another option is to 'next' if you don't want to show the zero totals
}
print "$i\t\t$results[$i]\n";
}
close($in_fh);
close($out_fh);
exit;

FTP application written in Perl doesn't connect

Why doesn't my program work? It refuses to connect to the host, I've tried two different servers and verified which port is used.
Note that I'm not very experienced when it comes to Perl.
use strict;
use Net::FTP;
use warnings;
my $num_args = $#ARGV+1;
my $filename;
my $port;
my $host;
my $ftp;
if($num_args < 2)
{
print "Usage: ftp.pl host [port] file\n";
exit();
}
elsif($num_args == 3)
{
$port = $ARGV[1];
$host = $ARGV[0];
$filename = $ARGV[2];
print "Connecting to $host on port $port.\n";
$ftp = Net::FTP->new($host, Port => $port, Timeout => 30, Debug => 1)
or die "Can't open $host on port $port.\n";
}
else
{
$host = $ARGV[0];
$filename = $ARGV[1];
print "Connecting to $host with the default port.\n";
$ftp = Net::FTP->new($host, Timeout => 30, Debug => 1)
or die "Can't open $host on port $port.\n";
}
print "Usename: ";
my $username = <>;
print "\nPassword: ";
my $password = <>;
$ftp->login($username, $password);
$ftp->put($filename) or die "Can't upload $filename.\n";
print "Done!\n";
$ftp->quit;
Thanks in advance.
Now that you already have your answer <> -> <STDIN>, I think I see the problem. When #ARGV contains anything, <> is the 'magic open'. Perl interprets the next item in #ARGV as a filename, opens it and reads it line by line. Therefore, I think you can probably do something like:
use strict;
use Net::FTP;
use warnings;
use Scalar::Util 'looks_like_number';
if(#ARGV < 2)
{
print "Usage: ftp.pl host [port] file [credentials file]\n";
exit();
}
my $host = shift; # or equiv shift #ARGV;
my $port = (looks_like_number $ARGV[0]) ? shift : 0;
my $filename = shift;
my #ftp_args = (
$host,
Timeout => 30,
Debug => 1
);
if ($port)
}
print "Connecting to $host on port $port.\n";
push #ftp_args, (Port => $port);
}
else
{
print "Connecting to $host with the default port.\n";
}
my $ftp = Net::FTP->new(#ftp_args)
or die "Can't open $host on port $port.\n";
#now if #ARGV is empty reads STDIN, if not opens file named in current $ARGV[0]
print "Usename: ";
chomp(my $username = <>); #reads line 1 of file
print "\nPassword: ";
chomp(my $password = <>); #reads line 2 of file
$ftp->login($username, $password);
$ftp->put($filename) or die "Can't upload $filename.\n";
print "Done!\n";
$ftp->quit;
Then if you had some connection creditials in a file (say named cred) like
myname
mypass
then
$ ftp.pl host 8020 file cred
would open host:8020 for file using credentials in cred.
I'm not sure you want to do that, its just that THAT is how <> works.