I have a file which I want to take all the lines which starts with CDS and a line below.
This lines are like:
CDS 297300..298235
/gene="ENSBTAG00000035659"
I found this in your site:
open(FH,'FILE');
while ($line = <FH>) {
if ($line =~ /Pattern/) {
print "$line";
print scalar <FH>;
}
}
and it works great when the CDS is only a line.
Sometimes in my file is like
CDS join(complement(416559..416614),complement(416381..416392),
complement(415781..416087))
/gene="ENSBTAG00000047603"
or with more lines in the CDS.
How can I take only the CDS lines and the next line of the ID???
please i need your help!
Thank you in advance.
Assuming the "next line" always contains /gene=, one can use the flip-flop operator.
while (<>) {
print if m{^CDS} ... m{/gene=};
}
Otherwise, you need to parse the CDS line. It might be sufficient to count parens.
my $depth = 0;
my $print_next = 0;
while (<>) {
if (/^CDS/) {
print;
$depth = tr/(// - tr/)//;
$print_next = 1;
}
elsif ($depth) {
print;
$depth += tr/(// - tr/)//;
}
elsif ($print_next) {
print;
$print_next = 0;
}
}
You need to break the input into outdented paragraphs. Outdented paragraphs start a non-space character in their first line and start with space characters for the rest.
Try:
#!/usr/bin/env perl
use strict;
use warnings;
# --------------------------------------
my $input_file = shift #ARGV;
my $para = undef; # holds partial paragraphs
open my $in_fh, '<', $input_file or die "could not open $input_file: $!\n";
while( my $line = <$in_fh> ){
# paragraphs are outdented, that is, start with a non-space character
if( $line =~ m{ \A \S }msx ){
# don't do if very first line of file
if( defined $para ){
# If paragraph starts with CDS
if( $para =~ m{ \A CDS \b }msx ){
process_CDS( $para );
}
# delete the old paragraph
$para = undef;
}
}
# add the line to the paragraph,
$para .= $line;
}
close $in_fh or die "could not close $input_file: $!\n";
# the last paragraph is not handle inside the loop, so do it now
if( defined $para ){
# If paragraph starts with CDS
if( $para =~ m{ \A CDS \b }msx ){
process_CDS( $para );
}
}
Related
I have a text file where is lot of lines, I need search in this file keywords and if exist write to log file line where is keywords and line one line below and one above the keyword. Now search or write keyword not function if find write all and I dont known how can I write line below and above. Thanks for some advice.
my $vstup = "C:/Users/Omega/Documents/Kontroly/testkontroly/kontroly20220513_154743.txt";
my $log = "C:/Users/Omega/Documents/Kontroly/testkontroly/kontroly.log";
open( my $default_fh, "<", $vstup ) or die $!;
open( my $main_fh, ">", $log ) or die $!;
my $var = 0;
while ( <$default_fh> ) {
if (/\Volat\b/)
$var = 1;
}
if ( $var )
print $main_fh $_;
}
}
close $default_fh;
close $main_fh;
The approach below use one semaphore variable and a buffer variable to enable the desired behavior.
Notice that the pattern used was replaced by 'A` for simplicity testing.
#!/usr/bin/perl
use strict;
use warnings;
my ($in_fh, $out_fh);
my ($in, $out);
$in = 'input.txt';
$out = 'output.txt';
open($in_fh, "< ", $in) || die $!."\n";
open($out_fh, "> ", $out) || die $!;
my $p_next = 0;
my $p_line;
while (my $line = <$in_fh>) {
# print line after occurrence
print $out_fh $line if ($p_next);
if ($line =~ /A/) {
if (defined($p_line)) {
# print previous line
print $out_fh $p_line;
# once printed undefine variable to avoid printing it again in the next loop
undef($p_line);
}
# Print current line if not already printed as the line follows a pattern
print $out_fh $line if (!$p_next);
# toggle semaphore to print the next line
$p_next = 1;
} else {
# pattern not found.
# if pattern was not detected in both current and previous line.
$p_line = $line if (!$p_next);
$p_next = 0;
}
}
close($in_fh);
close($out_fh);
I'm trying to shorten each line of a file to 96 characters while preserving whole words. If a line is under or equal to 96 chars, I want to do nothing with that line. If it over 96 chars, I want it cut it down to the closest amount less than 96 while preserving whole words. When I run this code, I get a blank file.
use Text::Autoformat;
use strict;
use warnings;
#open the file
my $filename = $ARGV[0]; # store the 1st argument into the variable
open my $file, '<', $filename;
open my $fileout, '>>', $filename.96;
my #file = <$file>; #each line of the file into an array
while (my $line = <$file>) {
chomp $line;
foreach (#file) {
#######
sub truncate($$) {
my ( $line, $max ) = #_;
# always do nothing if already short enough
( length( $line ) <= $max ) and return $line;
# forced to chop a word anyway
if ( $line =~ /\s/ ) {
return substr( $line, 0, $max );
}
# otherwise truncate on word boundary
$line =~ s/\S+$// and return $line;
die; # unreachable
}
#######
my $truncated = &truncate($line,96);
print $fileout "$truncated\n";
}
}
close($file);
close($fileout);
You have no output because you have no input.
1. my #file = <$file>; #each line of the file into an array
2. while (my $line = <$file>) { ...
The <$file> operation line 1 is in list context "consumes" all the input and loads it into #file. The <$file> operation in line 2 has no more input to read, so the while loop does not execute.
You either want to stream from the filehandle
# don't call #file = <$file>
while (my $line = <$file>) {
chomp $line;
my $truncated = &truncate($line, 96);
...
}
Or read from the array of file contents
my #file = <$file>;
foreach my $line (#file) {
chomp $line;
my $truncated = &truncate($line, 96);
...
}
If the input is large, the former format has the advantage of just loading a single line into memory at a time.
I have a file handle to read data from a file or from a pipe. Firstly, I read one line from the file handle. Then, I need to execute a while loop, taking into account the previously-read line. I think the seek function is problematic with pipes.
So my pseudocode is
local $line = <INPUT>;
seek(INPUT, -length($line), 1);
# if block
while (<INPUT>) {
}
Perhaps, there is a solution like this one?
while ($line, <INPUT>) {
}
Looking backward:
my $prev;
while (defined( my $line = <> )) {
... Use $prev and $line. $prev might not be defined. ...
$prev = $line;
}
Looking forward:
my $line = <>;
while (defined($line)) {
my $next = <>;
... Use $line and $next. $next might not be defined. ...
$line = $next;
}
In pairs:
if (defined( my $line1 = <> )) {
while (defined( my $line2 = <> )) {
... Use $line1 and $line2. Both will be defined. ...
$line1 = $line2;
}
}
Just remember the first line in a variable. Read the next line from the filehandle at the end of the loop:
#!/usr/bin/perl
use warnings;
use strict;
open my $FH, '-|', 'echo 3 ; seq 1 10' or die $!;
if (defined( my $first = <$FH> )) {
my $line = $first;
while () {
chomp $line;
print "$line:$first";
last if eof $FH;
$line = <$FH>;
}
}
A lot depends on why you want to do this. The easiest way is just to write a while read loop and save the line the first time it is executed. There's probably no need to read the first line and then also feed it into the read loop
Something like this perhaps
my $first_line;
while ( <> ) {
$first_line //= $_;
# Process $_
}
keyword harry /
sally/
tally/
want that whenever the string matches with keyword it should also look for "/" character.This signifies continuation of line
Then I want output as
keyword harry sally tally
==========================
My current code:
#!/usr/bin/perl
open (file2, "trial.txt");
$keyword_1 = keyword;
foreach $line1 (<file2>) {
s/^\s+|\s+$//g;
if ($line1 =~ $keyword_1) {
$line2 =~ (s/$\//g, $line1) ;
print " $line2 " ;
}
}
If the ===== lines in your question are supposed to be in the output, then use
#! /usr/bin/env perl
use strict;
use warnings;
*ARGV = *DATA; # for demo only; delete
sub print_line {
my($line) = #_;
$line =~ s/\n$//; # / fix Stack Overflow highlighting
print $line, "\n",
"=" x (length($line) + 1), "\n";
}
my $line = "";
while (<>) {
$line .= $line =~ /^$|[ \t]$/ ? $_ : " $_";
if ($line !~ s!/\n$!!) { # / ditto
print_line $line;
$line = "";
}
}
print_line $line if length $line;
__DATA__
keyword jim-bob
keyword harry /
sally/
tally/
Output:
keyword jim-bob
================
keyword harry sally tally
==========================
You did not specify what to do with the lines that do not contain the keyword. You might use this code as an inspiration, though:
#!/usr/bin/perl
use warnings;
use strict;
my $on_keyword_line;
while (<>) {
if (/keyword/ or $on_keyword_line) {
chomp;
if (m{/$}) {
chop;
$on_keyword_line = 1;
} else {
$on_keyword_line = 0;
}
print;
} else {
$on_keyword_line = 0;
print "\n";
}
}
A redo is useful when dealing with concatenating continuation lines.
my $line;
while ( defined( $line = <DATA> )) {
chomp $line;
if ( $line =~ s{/\s*$}{ } ) {
$line .= <DATA>;
redo unless eof(DATA);
}
$line =~ s{/}{};
print "$line\n";
}
__DATA__
keyword harry /
sally/
tally/
and
done!!!
$ ./test.pl
keyword harry sally tally and
done!!!
I think you need to simply concatenate all lines that end in a slash, regardless of the keyword.
I suggest this code.
Updated to account for the OP's comment that continuation lines are terminated by backslashes.
while (<>) {
s|\\\s*\z||;
print;
}
A perl script I'm writing needs to parse a file that has continuation lines like a Makefile. i.e. lines that begin with whitespace are part of the previous line.
I wrote the code below but don't feel like it is very clean or perl-ish (heck, it doesn't even use "redo"!)
There are many edge cases: EOF at odd places, single-line files, files that start or end with a blank line (or non-blank line, or continuation line), empty files. All my test cases (and code) are here: http://whatexit.org/tal/flatten.tar
Can you write cleaner, perl-ish, code that passes all my tests?
#!/usr/bin/perl -w
use strict;
sub process_file_with_continuations {
my $processref = shift #_;
my $nextline;
my $line = <ARGV>;
$line = '' unless defined $line;
chomp $line;
while (defined($nextline = <ARGV>)) {
chomp $nextline;
next if $nextline =~ /^\s*#/; # skip comments
$nextline =~ s/\s+$//g; # remove trailing whitespace
if (eof()) { # Handle EOF
$nextline =~ s/^\s+/ /;
if ($nextline =~ /^\s+/) { # indented line
&$processref($line . $nextline);
}
else {
&$processref($line);
&$processref($nextline) if $nextline ne '';
}
$line = '';
}
elsif ($nextline eq '') { # blank line
&$processref($line);
$line = '';
}
elsif ($nextline =~ /^\s+/) { # indented line
$nextline =~ s/^\s+/ /;
$line .= $nextline;
}
else { # non-indented line
&$processref($line) unless $line eq '';
$line = $nextline;
}
}
&$processref($line) unless $line eq '';
}
sub process_one_line {
my $line = shift #_;
print "$line\n";
}
process_file_with_continuations \&process_one_line;
How about slurping the whole file into memory and processing it using regular expressions. Much more 'perlish'. This passes your tests and is much smaller and neater:
#!/usr/bin/perl
use strict;
use warnings;
$/ = undef; # we want no input record separator.
my $file = <>; # slurp whole file
$file =~ s/^\n//; # Remove newline at start of file
$file =~ s/\s+\n/\n/g; # Remove trailing whitespace.
$file =~ s/\n\s*#[^\n]+//g; # Remove comments.
$file =~ s/\n\s+/ /g; # Merge continuations
# Done
print $file;
If you don't mind loading the entire file in memory, then the code below passes the tests.
It stores the lines in an array, adding each line either to the previous one (continuation) or at the end of the array (other).
#!/usr/bin/perl
use strict;
use warnings;
my #out;
while( <>)
{ chomp;
s{#.*}{}; # suppress comments
next unless( m{\S}); # skip blank lines
if( s{^\s+}{ }) # does the line start with spaces?
{ $out[-1] .= $_; } # yes, continuation, add to last line
else
{ push #out, $_; } # no, add as new line
}
$, = "\n"; # set output field separator
$\ = "\n"; # set output record separator
print #out;