Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Seekers of Perl Wisdom

( #479=superdoc: print w/replies, xml ) Need Help??

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
PDF::API2::Outline functions
1 direct reply — Read more / Contribute
by Copacetic
on May 26, 2017 at 11:07

    I have a PDF which doesn't have an index (which I believe is called an "outline"). I'd like to create one for it with links to various pages within the document. I've looked at the PDF::API2::Outline docs but they don't describe the parameters for each function, or include any examples. For instance, I don't know what any of the parameters for new() should be, or how the functions here relate to $otls->outline in PDF::API2.

    I haven't posted any code, as there are lots of parameters I could use which don't work.

    Any help would be much appreciated.

Sorting files by 3 numbers in the name
6 direct replies — Read more / Contribute
by crusty_collins
on May 26, 2017 at 09:37
    I have a task that requires me to sort several files by 3 numbers in the file name. What I have so far is a sort by a single number (run).
    Question : How can I sort by 3 numbers
    #!/usr/bin/perl use strict; use warnings; use Data::Dumper; # sort by run then by dist then by copy then by total # run district copy t +otal # | | | | #ASR0004994_8958_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_02_04_S my @files = qw( ASR0005336_8950_ETSTexas_EOC052017P_0517_Candidate_RRD_178904_01_0 ASR0004520_8960_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_04_0 ASR0004994_8958_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_02_0 ASR0005336_8950_ETSTexas_EOC052017P_0517_Candidate_RRD_178904_02_0 ASR0005154_8957_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_01_0 ASR0005336_8959_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_03_0 ASR0005336_8972_ETSTexas_EOC052017P_0517_Candidate_RRD_178902_01_0 ); # this sorts by the run number my @returnfiles = sort { ( $a =~ /^[^\d]*\d+_(\d{4})/ )[0] <=> ( $b =~ + /^[^\d]*\d+_(\d{4})/ )[0] } @files ; print Dumper @returnfiles;
    "We can't all be happy, we can't all be rich, we can't all be lucky and it would be so much less fun if we were. There must be the dark background to show up the bright colours." Jean Rhys (1890-1979)
Read Directory
4 direct replies — Read more / Contribute
by Nansh
on May 26, 2017 at 02:16
    Hi, My code is like this
    #!usr/bin/perl $path='/home/something/something/something'; opendir(DIR,$path) or die"couldnt open the directory\n"; while(readdir(DIR)) { if(-d BUS) { opendir(VEH,"BUS") or die"couldnt open the directory\n"; while(readdir(VEH)) { print "$_\n"; } } }

    In this path $path='/home/something/something/something'; many directories are there. say BUS, CAR, LORRY If the directory BUS exists then read that directory and display the files in that directory I am trying but i am not able to get that

Moose: Giving objects access to data of class that created it
3 direct replies — Read more / Contribute
by nysus
on May 25, 2017 at 15:28

    I'm curious to know how I might give objects created by a parent class access to the data in the parent class:

    { package parent 0.000001; use Moose; has 'changing_data' => (is => 'rw', isa => 'Str', default => ''); sub set_data { my $s = shift; $s->changing_data('foo foo foo'); } sub create_child { my $s = shift; my $data = shift; return child->new(changing_data => $data); } } { package child 0.00001; use Moose; extends 'parent'; } my $p = parent->new(); $p->set_data; my $child = $p->create_child($p->changing_data()); print $child->changing_data; $p->changing_data('bar bar bar'); print "\n"; print $child->changing_data; # desired output foo foo foo bar bar bar # actual output foo foo foo foo foo foo

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Subroutine processes only one file in the directory
1 direct reply — Read more / Contribute
by sridhar56
on May 25, 2017 at 15:22
    I have a directory of text files and I want to process each file in that directory using the subroutine average to calculate the average for a file. However, my script processes the same file every time. I am not sure what is the mistake I am doing here. Below is the code I wrote:
    #!/usr/bin/perl #Naga_betrapally_6_3_16 use strict; use warnings; use Cwd; use FileHandle; my $name; + # Naming of variables, remembers the name of the +file my $cwd = getcwd(); + #Takes in the current directory of files my $opendir = "$cwd"; + #Used to open the current directory and remembers t +he location opendir (DIR, $opendir) or die $!; + #Open directory command my @directory = readdir DIR; + #Grabbing all the fas files stored in the location my $scalar = scalar(@directory); + #Counting the number of files and printing it in th +e next line #print "The number of sample files in this folder: $scalar \n"; # for (my $i=0; $i<scalar(@directory); $i++){ # $name = "$directory[$i]"; # print "The file read in: $name\n"; # my $digits = substr $name, 0, 4; + #Grabbing the first 4 characters to name the sample + run for MEGA # my $tmp = "$opendir/$directory[$i]"; # } for(my$i=0;$i<@directory;$i++){ print $directory[$i]; &average($directory[$i]); } #average(@directory); sub average { my $header; my @array_lines; my $n=0; my $filename=@_; + #Takes in the sequence file from the user inpu +t with the year in the header my @average_array; my $sum =0; my $avarage; next if($filename =~ /^\.$/); next if($filename =~ /^\.\.$/); open (FILE,$filename) or die "No input file provided or the input file + does not exist in the path, '$_' $!"; print "$filename\n"; while (my $file = <FILE>){ chomp $file; if ($file =~/^Name/){ $header = $file; } else{ $array_lines[$n] = $file; chop $array_lines[$n]; $n++; } } for(my $i=0;$i<@array_lines;$i++){ my @tmp = split(/\t/,($array_lines[$i])); #print $tmp[3]; push @average_array, $tmp[3]; my $scalar = scalar(@average_array); #print $scalar; } foreach (@average_array){ #print "$_\n"; my $tmp = $_; $tmp =~ s/,//; #print "$tmp\n"; $sum = $sum+$tmp; } #print "The sum of all the mapping is $sum\n"; $avarage = $sum/11; #print "THe average of the mapping is $avarage\n"; close (FILE); }
    All the files in that folder maintain the same structure as the sample file below:
    Name Consensus length Total read count Average coverage Re +ference sequence Reference length NSP4-E1 mapping 750 227760 64,516.84 NSP4-E1 750 VP7-G3 mapping 1062 303758 63,062.33 VP7-G3 1062 Rotarix-VP6 mapping 1356 161491 26,020.50 Rotarix-VP6 1 +356 Rotarix-NSP1 mapping 1559 114394 16,077.21 Rotarix-NSP1 + 1568 NSP2-N1 mapping 1059 80424 16,178.61 NSP2-N1 1058 NSP5-H1 mapping 664 75269 23,943.71 NSP5-H1 663 VP1-R1 mapping 3302 69677 4,542.15 VP1-R1 3302 VP2-C1 mapping 2717 149312 11,987.00 VP2-C1 2717 VP3-M1 mapping 2591 31795 2,632.39 VP3-M1 2591 RotaTeq-WI79-4-VP4 mapping 2359 78305 7,223.08 RotaTeq-WI7 +9-4-VP4 2359 NSP3-T1 mapping 1074 173210 34,910.87 NSP3-T1 1074
email fails with attachments over 8kb
2 direct replies — Read more / Contribute
by abrunskie
on May 25, 2017 at 10:27

    I have a script that sends out emails with attachments and now all of a sudden it has stopped working when the attachment size is over 8kb. I found one post on the web that was similar ( but that solution has not worked for me. I am not a programmer. Someone else wrote this code -- I simply know how to tinker with it a bit and how to compile it. A previous compile that I did in 2014 is still working just fine and I'm pretty sure it is the exact same code. But for some reason, if I compile it now I get an error like this:

    Net::SMTP::_SSL=GLOB(0x58ce8e4)>>> Net::SMTP::_SSL=GLOB(0x58ce8e4)>>> --_----------=_149565979242000-- Net::SMTP::_SSL: Net::Cmd::datasend(): unexpected EOF on command channel: Bad file descriptor at line 161. 2017-05-24 16:03:10: The server "" refused to accept the message. Trying next message if there is one. Net::SMTP::_SSL: Net::Cmd::_is_closed(): unexpected EOF on command channel: Bad file descriptor at line 163.

    #!/usr/bin/perl -- use strict; use warnings; use POSIX qw(strftime); chdir "$ENV{'USERPROFILE'}\\Desktop"; #this will direct email log file + to each users My Documents folder # my $infolog = strftime("%Y%m%d",localtime(time)); # $infolog .="_email_log.txt"; my $logtime = strftime("%Y-%m-%d %H:%M:%S",localtime(time)); $|++; #make encrypted smtp sender # package SMTPS; # { #enclose the package in a block. Probably not necessary with "pac +akge main" but why not # no strict 'refs'; use IO::Socket::SSL; use Net::SMTP; # use Email::Send::SMTP::Gmail # use vars qw(@ISA); # @ISA = ('IO::Socket::SSL', grep {$_ ne 'IO::Socket::INET'} @Net::SM +TP::ISA); # foreach (keys %Net::SMTP::) { # next unless defined *{$Net::SMTP::{$_}}{CODE}; # *{$_} = \&{"Net::SMTP::$_"}; # } #} package main; #open(STDERR, ">>", "$infolog"); #open (OUTPUT, ">>", "$infolog"); open(STDERR, ">>email_log.txt"); open (OUTPUT, ">>email_log.txt"); my %conf; while (my ($key, $value) = splice(@ARGV,0,2)) { if ($key eq '-v') { unshift @ARGV, $value if $value; $conf{'-v'}++; } else {$conf{$key} = $value;} } if ($conf{'-c'}) { open(CONF, $conf{'-c'}) or die qq($logtime: Can't open the file spec +ified with the '-c' switch: "$conf{'-c'}"\nThe error message was:\n\t +$!\n); while (<CONF>) { chomp; next if /^\s*$/ or /^#/; my ($key, $value) = split ' ', $_, 2; if ($key eq '-v') {$conf{'-v'}++;} else {$conf{$key} = $value unless $conf{$key};} } close CONF; } my $work_book = $conf{'-w'} or die qq($logtime: You must specify a wor +kbook with the '-w' switch\n); my $work_sheet = $conf{'-t'} or die qq($logtime: Make sure there are n +o spaces in the file path where param file is kept. (You must specify + a sheet in the workbook with the '-t' switch.) \n); my $range = $conf{'-r'} or die qq($logtime: You must specify a range o +n the sheet with the '-r' switch\n); my $mail_host = $conf{'-m'} or die qq($logtime: You must specify an em +ail server with the '-m' switch\n); my $return_address = $conf{'-a'} || q(; my $msg_file = $conf{'-f'} || ''; my $subject = $conf{'-s'} || qq(Accounting Report); my $authuser = $conf{'-u'} || ''; my $authpass = $conf{'-p'} || ''; my $debug = $conf{'-v'} || 0; my $smtp_debug = 1; # 0=no debug; 1=debug if ($debug > 1) { $smtp_debug = 1;} my $mail_host_port = 465; if ($mail_host =~ /:/) { ($mail_host, $mail_host_port) = split /:/, $m +ail_host; } #change backslashes to forward slashes just in case $work_book =~ tr|\\|/|; if ($debug) { print OUTPUT qq($logtime: You haven't specified a return address for t +he message. Return address set to "branch_finance\".\n) unle +ss $conf{'-a'}; print OUTPUT qq($logtime: You haven't specified a subject for the me +ssage. Subject set to "Accounting Report".\n) unless $conf{'-s'}; print OUTPUT qq($logtime: You haven't specified any text for the mes +sage. The message will consist of only the attachment.\n) unless $ms +g_file; } my $msgtxt = qq( \n); if (($msg_file) && (open(MSGTXT, "$msg_file"))) { local $/ = undef; $msgtxt = <MSGTXT>; close MSGTXT; } use Spreadsheet::ParseExcel; print qq(Trying to open "$work_book"\n) if $debug; my $ss = Spreadsheet::ParseExcel::Workbook->Parse("$work_book") or die + qq($logtime: Can't read $work_book\n$!\n); print qq(Checking for sheet "$work_sheet"\n) if $debug; my $ws = $ss->Worksheet("$work_sheet"); die qq($logtime: Can't find sheet "$work_sheet" in "$work_book"\n) unl +ess defined $ws; my ($start_range, $end_range) = split /:/, $range; $start_range =~ /([a-zA-Z]+)(\d+)/; my($first_col,$first_row) = (ord($1)-65,$2-1); $end_range =~ /([a-zA-Z]+)(\d+)/; my($last_col,$last_row) = (ord($1)-65,$2-1); print qq(Making a secure connection to mail server "$mail_host" on por +t "$mail_host_port".\n) if $debug; my $smtp = Net::SMTP->new($mail_host,Port=>$mail_host_port,Hello=>'ACC',Debug=>$smtp_debug, SSL=>1) or die qq($logtime: Cannot make a secure connection to "$mail_host" on + port "$mail_host_port" so no messages can be sent. Please make sure + that you can access "$mail_host".\nThe error was $@\n); #ab my $smtp = SMTPS->new($mail_host,Port=>$mail_host_port,Hello=>'ACC',Debug=>$smtp_debug) or die qq($logtime: Cannot m +ake a secure connection to "$mail_host" on port "$mail_host_port" so +no messages can be sent. Please make sure that you can access "$mail +_host".\nThe error was $@\n); if ($authuser and $authpass) { print qq(Authenticating as user "$authuser"\n) if $debug; $smtp->auth($authuser,$authpass) or print qq(Unable to authenticate +to "$mail_host" with account "$authuser".\nTrying to send messages an +yway... \n); #ab: changed warn to print } use File::Basename qw(fileparse); foreach my $i ($first_row..$last_row) { my $full_file_name = $ws->Cell($i,$first_col)->Value(); $full_file_name =~ tr|\\|/|; #just in case print qq(CELL ), chr($first_col+65), $i+1, qq( = "$full_file_name"\n +) if $debug; (my $email_address_line = $ws->Cell($i,$last_col)->Value()) =~ s/\s* +[,;]\s*/, /g; my @email_addresses = split /, /, $email_address_line; print qq(CELL ), chr($last_col+65), $i+1, qq( = "$email_address_line +"\n) if $debug; my ($file_name, $dir, $ext) = fileparse($full_file_name,'\.[^.]*$'); print qq(PATH = "$dir", FILE = "$file_name", EXT = "$ext"\n) if $deb +ug; unless (-e $full_file_name) { print OUTPUT qq($logtime: The file "$full_file_name" does not exis +t. Please check the data in "$work_book" and make sure that you have + access to this file.\nTrying next file if there is one.\n); #ab: cha +nged warn to print next; } my $mime; $ext = lc($ext); if ($ext eq '.pdf') {$mime = 'application/pdf';} elsif ($ext eq '.xls') {$mime = 'application/msexcel';} elsif ($ext eq '.xlsx') {$mime = 'application/msexcel';} elsif ($ext eq '.zip') {$mime = 'application/x-zip-compressed';} elsif ($ext eq '.txt') {$mime = 'text/plain';} elsif (($ext eq '.html') or ($ext eq '.htm')) {$mime = 'text/html';} else { $mime = 'application/octet-stream'; print OUTPUT qq($logtime: The extension "$ext" is unknown so the a +ttachment will be encoded as 'application/octet-stream'.\n) if $debug +; } my $email = make_header($email_address_line,$full_file_name, "${file +_name}$ext", $mime) or do { warn qq($logtime: Can't properly encode "$full_file_name". Make +sure you have access to this file.\nTrying next file if there is one. +\n); $smtp->reset(); next; }; print qq(Attempting to send $full_file_name to $email_address_line\n +) if $debug; print qq(Setting return address: "$return_address"\n) if $debug; unless ($smtp->mail($return_address)) { $smtp->quit(); die qq($logtime: The server "$mail_host" has refused to accept a +ny mail with the return address: "$return_address". Please make sure + this is a valid email address.\n); } my @good_addresses; foreach my $address (@email_addresses) { print qq(Adding recipient: "$address"\n) if $debug; if ($smtp->recipient($address)) { push @good_addresses, $address +; } else { warn qq($logtime: The server "$mail_host" refused to accept ma +il for user "$address", so the message cannot be sent to this address +.\nCheck if the address is properly formed (user\ or see +if you need to authenticate before sending.\nTrying next recipient if + there is one.\n); next; } } unless (scalar @good_addresses > 0) { warn qq($logtime: The server refused all the recipients\nPerhaps + you need to authenticate before sending?\nTrying next message if the +re is one.\n); $smtp->reset(); next; } print qq(No more recipients... Sending message data\n) if $debug; unless ($smtp->data($email)) { warn qq($logtime: The server "$mail_host" refused to accept the +message.\nTrying next message if there is one.\n); $smtp->reset(); next; } print OUTPUT qq($logtime: File "$full_file_name" successfully sent t +o @good_addresses\n) if $debug; $smtp->reset(); } print qq(Done sending. Closing connection to "$mail_host"\n) if $debug +; # print qq(Done sending. Closing connection to "$mail_host"\n) if $deb +ug; close OUTPUT; close STDERR; $smtp->quit(); sub make_header { use MIME::Base64; use MIME::Lite; my ($to_address, $filepath, $filename, $app_type) = @_; my $msg = MIME::Lite->new( To =>$to_address, From =>$return_address, Subject =>$subject, Type =>'multipart/mixed' ) or return undef; $msg->attach( Type =>'TEXT', Data =>$msgtxt ) or return undef; $msg->attach( Type =>"$app_type", Path =>$filepath, Filename =>$filename ) or return undef; return $msg->as_string; }
TCP Server: Beyond echoing request
2 direct replies — Read more / Contribute
by jeremywakeman
on May 25, 2017 at 10:03

    I'm building a TCP server to learn more about networking. What I have so far is based on various online examples: a server that responds to requests using a series of if, elsif, elsif attempts to match the request to an appropriate response.

    It seems like I should be looking to implement an application layer protocol to transfer data (text) between server and client, but I don't want to invent my own protocol or use one that's more complex than I need. Google searches have not resulted in a definitive answer. Is there an existing protocol I should look into?

    At the moment my client is just nc to the appropriate server port. I'm assuming I'll have to build a client if I implement an application level protocol

    #!/usr/bin/perl use warnings; use strict; use POSIX; use IO::Socket; use IO::Select; use Tie::RefHash; my $port = 1800; ### Create the server socket. my $server = IO::Socket::INET->new( LocalPort => $port, Listen => 10, ) or die "can't make server socket: $@\n"; $server->blocking(0); ### Set up structures to track input and output data. my %inbuffer = (); my %outbuffer = (); my %ready = (); tie %ready, "Tie::RefHash"; ### The select loop itself. my $select = IO::Select->new($server); while (1) { # Process sockets that are ready for reading. foreach my $client ($select->can_read(1)) { handle_read($client); } # Process any complete requests. Echo the data back to the client, # by putting the ready lines into the client's output buffer. foreach my $client (keys %ready) { foreach my $request (@{$ready{$client}}) { process_request($client,$request); } delete $ready{$client}; } # Process sockets that are ready for writing. foreach my $client ($select->can_write(1)) { handle_write($client); } } exit; sub process_request { my ($client,$request) = @_; print "Got request: $request"; chomp $request; if ( $request eq "HELLO" ) { $outbuffer{$client} .= "TEST SERVER 0.1\n"; } elsif ($request eq "GET NODES" ) { $outbuffer{$client} .= "NODES: 0 ZERO, 1 ONE, 2 TWO, 4 FOUR\n" +; } elsif ( $request =~ /^JOIN / ) { $outbuffer{$client} .= "JOINING NOT IMPLEMENTED\n"; } elsif ( $request =~ /^MSG / ) { $outbuffer{$client} .= "MSGING NOT IMPLEMENTED\n"; } else { $outbuffer{$client} .= "UNKNOWN COMMAND\n"; } } ### Handle a socket that's ready to be read from. sub handle_read { my $client = shift; # If it's the server socket, accept a new client connection. if ($client == $server) { my $new_client = $server->accept(); $new_client->blocking(0); $select->add($new_client); return; } # Read from an established client socket. my $data = ""; my $rv = $client->recv($data, POSIX::BUFSIZ, 0); # Handle socket errors. unless (defined($rv) and length($data)) { handle_error($client); return; } # Successful read. Buffer the data we got, and parse it into lines. # Place the lines into %ready, where they will be processed later. $inbuffer{$client} .= $data; while ($inbuffer{$client} =~ s/(.*\n)//) { push @{$ready{$client}}, $1; } } ### Handle a socket that's ready to be written to. sub handle_write { my $client = shift; # Skip this client if there's nothing to write. return unless exists $outbuffer{$client}; # Attempt to write pending data to the client. my $rv = $client->send($outbuffer{$client}, 0); unless (defined $rv) { warn "I was told I could write, but I can't.\n"; return; } # Successful write. Remove what was sent from the output buffer. if ( $rv == length($outbuffer{$client}) or $! == POSIX::EWOULDBLOCK) { substr($outbuffer{$client}, 0, $rv) = ""; delete $outbuffer{$client} unless length $outbuffer{$client}; return; } # Otherwise there was an error. handle_error($client); } ### Handle client errors. Clean up after the dead socket. sub handle_error { my $client = shift; delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); close $client; }
Use CGI to run a Perl script via web server
5 direct replies — Read more / Contribute
by suvajit123
on May 25, 2017 at 07:07

    Hello Monks

    I have created a Perl script which runs fine manually with a value parsed during runtime, i.e. like 'perl value'

    I need to execute this over a Web Server (IBM HTTP Server), I have configured it correctly and it is able to execute the program to display Hello World with a name given as input in the URL. like

    But my actual code which calls for a different Perl script from this, does not work.

    #!/usr/bin/perl use strict; use CGI; use IPC::System::Simple qw(system capture); #create CGI query object to get the SSO from URL my $sso = new CGI; my $sso = $query->param( "sso" ); #*********Script within a script both files in same path********** system( "perl $sso" ); print "Content-type:text/html\r\n\r\n"; print "<html>"; print "<head>"; print "<title>Some Header</title>"; print "</head>"; print "<body>"; print "<h2>You have entered $sso</h2>"; print "</body>"; print "</html>";

    This is not working as it is not detecting IPC::System::Simple qw(system capture) from this script. How could I make the CGI parse the $sso to ?

    Thanks in advance....

Regex problem
2 direct replies — Read more / Contribute
by dazz
on May 25, 2017 at 05:35
    I download a web page that includes data used and remaining data for a mobile connection.
    I want to find the two values and convert them from strings to values.

    A snippet of the html page is:
    <span class="remaining-data">54MB used</span> <span class="expires-data-right-align">1.44GB remaining</span>
    I use the regex to get a matching substring with the 1st value within
    (my $DataUsed) = $stgUsed =~ /"remaining-data">([+-]?(\d*\.)?\d+)(MB +|GB) used/; # trying to get just the digits. (my $unit) = $stgUsed =~ /(MB|GB)/; # match either MB or GB if ( $unit eq "GB"){ $DataUsed *= 1000; }
    The output in $stgUsed is what I expect:
    DB<5> x $stgUsed 0 'class="remaining-data">315MB'
    In want to capture just the number (315) and the units (MB) but $DataUsed in undef.
    I have tried using $1,$2 ... but they are undef as well.

    How to I get the digits substring and the MB/GB substring????

Undefined Subroutine error
4 direct replies — Read more / Contribute
by pdahal
on May 25, 2017 at 05:34

    hello monks! Below I have posted my code. I am getting an error which says "Undefined subroutine &main::fields called at line 34, <$data> line 2." Can anyone help me?

    #Written by Prasuna Dahal use warnings; use XML::Simple; use LWP::UserAgent; use HTTP::Request::Common; use URI::Escape; use Text::CSV; use Data::Dumper; my $i = 0; my @keystr; my @kwrds = {"inhibitors", "activity", "complex", "activator", "activi +ty", "activities", "activated", "proteins", "deficiency", "levels", " +functions", "reductions", "protease", "proteases"}; my $file = "proteinlist.csv"; my $ua = LWP::UserAgent->new; my $csv = Text::CSV->new({sep_char => ','}); #Open the result in a CSV file open (my $fh, ">", "test1.csv"); print $fh "Valid Proteins\n"; #open file containig protein_name #open(my $data1, '<', "proteinlist.csv"); #Open the file containing the PubMed IDs open(my $data, '<', "test.csv"); while (my $line = <$data>) { chomp $line; if ($csv->parse($line)) { #Skip 1st line next if ($. == 1); my @fields = $csv-fields(); #Replace (-) with (,) $fields[0] =~ tr/-/,/; my $id = $fields[0]; #Initialize http request my $args = "db=pubmed&id=$id&retmode=text&rettype=abstract"; my $req = new HTTP::Request POST => 'https://eutils.ncbi.nlm.nih.g +ov/entrez/eutils/efetch.fcgi'; $req->content_type('application/x-www-form-urlencoded'); $req->content($args); #Get response my $response = $ua->request($req); my $content = $response->content; $fields[0] =~ tr/,/-/; my @abstract = split (/[.]/, $content); for $abstract(@abstract){ @var1 = split ((/[ ]|[,]/), $abstract); foreach $var1(@var1){ open(my $data1, "<", $file); while (my $line1 = <$data1>) { chomp $line1; my @fields1 = split ",", $line1; $keystr[$i] = $fields1[0]; $i++; if ($var1=~ /\b$keystr[$i]\b/i){ foreach $kwrds(@kwrds){ if ($var1=~ /\b$kwrds\b/i){ my $valid_prot = $var1; } } print $fh "$valid_prot\n"; print "$valid_prot\n"; } } } } } } close($fh);

Add your question
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (9)
    As of 2017-05-26 17:51 GMT
    Find Nodes?
      Voting Booth?