Perl Notes

Dna2Protein.pl

my $DNA = <STDIN>;
chomp $DNA;

$protein = myfunc2($DNA);
print "Protein Sequence:\n";
print($protein, "\n");

sub myfunc2 {
	my %aacode = (
		TTT => "F", TTC => "F", TTA => "L", TTG => "L",
		TCT => "S", TCC => "S", TCA => "S", TCG => "S",
		TAT => "Y", TAC => "Y", TAA => "STOP", TAG => "STOP",
		TGT => "C", TGC => "C", TGA => "STOP", TGG => "W",
		CTT => "L", CTC => "L", CTA => "L", CTG => "L",
		CCT => "P", CCC => "P", CCA => "P", CCG => "P",
		CAT => "H", CAC => "H", CAA => "Q", CAG => "Q",
		CGT => "R", CGC => "R", CGA => "R", CGG => "R",
		ATT => "I", ATC => "I", ATA => "I", ATG => "M",
		ACT => "T", ACC => "T", ACA => "T", ACG => "T",
		AAT => "N", AAC => "N", AAA => "K", AAG => "K",
		AGT => "S", AGC => "S", AGA => "R", AGG => "R",
		GTT => "V", GTC => "V", GTA => "V", GTG => "V",
		GCT => "A", GCC => "A", GCA => "A", GCG => "A",
		GAT => "D", GAC => "D", GAA => "E", GAG => "E",
		GGT => "G", GGC => "G", GGA => "G", GGG => "G",
	); # this is the hash table for the amino acids
	my ($rec_DNA) = @_;
	$rec_DNA =~ tr/atcg/ATCG/;
	my $protein;
	# for (my $i = 0; $i < (length $rec_DNA) / 3; $i++) {
	for (my $i = 0; $i < length $rec_DNA; $i = $i + 3) {
		my $codon = substr($rec_DNA, $i, 3);
		$protein .= %aacode{$codon};
		# $protein = $protein . substr($rec_DNA, $i*3, 3);
		# $protein = $protein + substr($rec_DNA, $i*3, 3);
	}
	return $protein;
}

my_first_GO_script.pl

my $entry_count=0;
my %go_hash=();
open IN,$ARGV[0];
while(<IN>){
    if($_=~ /^ID\s+/){
	    $entry_count++;
    }
    elsif($_=~ /^DR\s+GO;\s+(GO:[0-9]+;\s+P:[^\;]+);/){
	    $go_hash{$1}++;
    }
}
close IN;
printf "Count\tPercentage\tProcess\n";
foreach $key (sort {$go_hash{$b}<=>$go_hash{$a}} keys %go_hash){
    print $go_hash{$key},"\t",sprintf("%.2f",$go_hash{$key}/$entry_count*100),"\t",$key,"\n";
}

Perl.md

Perl language for bioinfromatics

week2_1.pl

$cnt=0;

while(<>) {
   if($_=~ /^ID/) {
       $cnt++
   }
};

print "Number of entries:$cnt\n"

week2_2.pl

# $var is a scalar (single string or number)
$x = 10;
$s = "ATTGCGTA";

# @var stores array (a list of values) (array has not type)
@ab = (100, $x, "ATGCCAGT");
print("@ab\n");

# %var stores hash
%ages = {"John" => 30, "Mary" => 22, "Lakshmi" => 27};
print(%ages{"Mary"}, "\n");
print("##################################################\n");

# use strict; # at this top of the file
# certain rules controll, my, our, local
my $a;
my @array = qw/A list of words/; # string to array split by spaces
my $b = "A String";
print("$a\n");
print("@array\n");
print("$b\n");
print("##################################################\n");

@array1 = ('one', 'two', 'three');
$loa = @array1;
print("$loa\n");
($loa) = @array1;
print("$loa\n");
($b, $c) = @array1;
print($b, $c, "\n");

$DNA1 = "ATG";
$DNA2 = "CCC";

$DNA3 = $DNA1 . $DNA2; # concatenation
$DNA3 = "$DNA1$DNA2"; # interpolation
print("$DNA3\n");
print('$DNA3' . "\n");
print("##################################################\n");

# =~ : match operator
$dna = "ATGCATTT";
# $pattern = $ARGV[0];
$pattern = "ATT";
if ($dna =~ /$pattern/) {
	print("$dna contains $pattern\n");
}
else {
	print("$dna does not contain $pattern\n");
}
print("##################################################\n");

# =~ s/Find/Replace/ : substitution
print "(single) substitution example:\n";
print("Old DNA: $dna\n");
$dna =~ s/AT/gggagct/;
print("New DNA: $dna\n");

print "global substitution:\n";
$dna =~ s/g/AT/g;
print("New global substituted DNA: $dna\n");

print "removing white space\n";
$dna = "ATG GCA      A T G";
print("With Space DNA: $dna\n");
$dna =~ s/\s//g;
print("Space Removed DNA: $dna\n");

print "substitution ignoring case\n";
$dna = "ATGCAttT";
print "Old DNA: $dna\n";
$dna =~ s/T/U/gi;
print "New DNA: $dna\n";
print("##################################################\n");

# =~ tr/Find/Replace/ : transliteration
print "transliteration operator\n";
$dna = "ATGCAttT";
print "Old DNA: $dna\n";
$dna =~ tr/T/U/;
print "New DNA: $dna\n\n";

print "tr on multiple characters\n";
$dna = "ATGCAttT";
print "Old DNA: $dna\n";
$dna =~ tr/Tt/Uu/;
print "New DNA: $dna\n\n";

print "DNA complement strand\n";
$dna = "ATGCAttT";
$complement = $dna;
$complement =~ tr/AaTtGgCc/TtAaCcGg/;
print "$dna\n";
print "$complement\n\n";
print("##################################################\n");

print "length function\n";
$dna = "ATGCAttT";
$size = length($dna);
print "DNA $dna has length $size\n\n";

print "reverse function\n";
$dna = "ATGCAttT";
$reverse_dna = reverse($dna);
print "DNA: $dna\n";
print "Reverse DNA: $reverse_dna\n\n";

print "reverse complement\n";
$dna = "ATGCAttT";
$rev_comp = reverse($dna);
$rev_comp =~ tr/AaTtGgCc/TtAaCcGg/;
print "$dna\n";
print "$rev_comp\n\n";
print("##################################################\n");

week2_3.pl

print "array of gene names\n";
@genes = ("HOXB1", "ALPK1", "TP53");
$size = scalar @genes;
print "A list of $size genes: @genes\n";
@genes = reverse @genes;
print "Reversed list of $size genes: @genes\n";
@genes = sort @genes;
print "Sorted list of $size genes: @genes\n\n";
print("##################################################\n");

print "Appending to an array\n";
@genes = ("HOXB1", "ALPK1", "TP53");
push @genes, "ZZZ3";
$size = scalar @genes;
print "There are now $size genes: @genes\n";
push @genes, ("EGF", "EFGR");
$size = scalar @genes;
print "There are now $size genes: @genes\n\n";
print("##################################################\n");

print "Removing items from end of array\n";
@genes = ("HOXB1", "ALPK1", "TP53", "EGF");
$size = scalar @genes;
print "A list of $size genes: @genes\n";
pop @genes;
$size = scalar @genes;
print "There are now $size genes: @genes\n";
$gene = pop @genes;
$size = scalar @genes;
print "There are now $size genes: @genes\n";
print "There gene removed was $gene\n\n";
print("##################################################\n");

print "Removing items from front of array\n";
@genes = ("HOXB1", "ALPK1", "TP53", "EGF");
$size = scalar @genes;
print "A list of $size genes: @genes\n";
shift @genes;
$size = scalar @genes;
print "There are now $size genes: @genes\n";
$gene = shift @genes;
$size = scalar @genes;
print "There are now $size genes: @genes\n";
print "There gene removed was $gene\n\n";
print("##################################################\n");

week2_4.pl

@genes = ("HOXB1", "ALPK1", "TP53");
while (scalar @genes > 0) {
	$gene = shift @genes;
	print "Processing gene $gene\n";
	# put processing code here
}
$size = scalar @genes;
print "There are now $size genes in the list: @genes\n";
print("##################################################\n");

print "for loop to process all items from a list\n";
@genes = ("HOXB1", "ALPK1", "TP53");
foreach $gene (@genes) {
	print "Processing gene $gene\n";
	# put processing code here
}
$size = scalar @genes;
print "There are still $size genes in the list: @genes\n";
print("##################################################\n");

print "another for loop to process a list\n";
@genes = ("HOXB1", "ALPK1", "TP53");
$size = scalar @genes;
for (my $i = 0; $i < $size; $i++) { # my $i demek sadece bu for da $i değişkeni var demek dışardan erişilemez.
	$gene = $genes[$i];
	print "Processing gene $gene\n";
	# put processing code here
}
$size = scalar @genes;
print "There are still $size genes in the list: @genes\n";
print("##################################################\n");

print "converting array to string\n";
@genes = ("HOXB1", "ALPK1", "TP53");
$string = join("\n", @genes);
print "String of genes: $string\n";
$size = length $string;
print "String has length: $size\n";
print("##################################################\n");

print "converting string to array\n";
$dna = "ATGCATTT";
@bases = split "", $dna;
print "dna = $dna\n";
$size = scalar @bases;
print "The list of $size bases: @bases\n";
print("##################################################\n");

print("@ARGV\n");

week3_1_Hashes.pl

# %genes = ( "gene1", "ATTCGT", "gene2", "CTGCCATGA");
%genes = (gene1=>"ATTCGT", gene2=>"CTGCCATGA");
# $seq = $genes{"gene2"}; # $seq = "CTGCCATGA"
$genes{gene2} = "CTGCCATGA";
print("$seq\n");
print("##################################################\n");

%genes = (gene2=>"CTGCCATGA", gene1=>"ATTCGT");
@key_list = keys(%genes);
print "@key_list\n"; # prints: gene1 gene2
# often used to loop through a hash:
foreach $key (@key_list) {
	print "The value of $key is $genes{$key}\n";
}
print("##################################################\n");

# exists($H{$key}) returns TRUE if $key occurs in hash %H
# print all the words in a file with their counts
my ($file) = @ARGV;
open FH, $file;
my @lines = <FH>;
close FH;
my %count = ();
for my $line (@lines) {
	for my $word (split " ", $line) {
		if (not exists $count{$word}) {
			# initialize the count for a new word
			$count{$word} = 1;
		}
		else {
			# update the count for an existing word
			$count{$word}++;
		}
	}
}
for my $key (sort keys %count) {
	print "$key $count{$key}\n";
}

week3_2_Regex.pl

$str =~ /^\s*$/; # match if string $str contains 0 or more white space characters

$str =~ /^[A-Z]+$/; # string $str contains all capital letters (at least one)

$str =~ /[A-Z]\d*/; # string $str contains a capital letter followed by 0 or more digits

$n =~ /^\d+\.\d+$/; # number $n contains some digits before and after a decimal point

$s =~ /A..B/; # string contains A and B separated by any two characters

$s !~ /ATG/; # string does NOT contains ATG

# match if string $str contains any sequence of three consecutive A's
$str =~ /AAA/;
$str =~ /A{3}/;

# match if string $str consist of exactly three A's
$str =~ /^AAA$/;
$str =~ /^A{3}$/;

# match if $str contains a codon for Alanine (GCA, GCT, GCC, GCG)
$str =~ /GC./;

# match if $str contains a STOP codon (TAA, TAG, TGA)
$str =~ /TA[AG]|TGA/;
$str =~ /T(AA|AG|GA)/;
$str =~ /T(A[AG]|GA)/;

# string contains any word containing all capital letters
$str =~ /\b[A-Z]+\b/;

# A followed by any number of C or G's followed by T or A
$str =~ /A[CG]*(T|A)/;
$str =~ /A[CG]{0,}[TA]/;

# TT followed by one or more CA's followed by anything except G
$str =~ /TT(CA)+[^G]/;

# string begins with B and has between 5 and 10 letters
$str =~ /^B.{4,9}$/;

# string consists of a 10 digit phone number: ddd-ddd-dddd
$str =~ /^\d\d\d\-\d\d\d\-\d\d\d\d$/;
$str =~ /^\d{3}\-\d{3}\-\d{4}$/;

print("##################################################\n");

$str = "Perl is a programming language used for bioinformatics.";
$str =~ /(.*) is.*(b.*)\./;
$first = $1;
$second = $2;
print "$first $second\n";
# prints "Perl bioinformatics"
# or, you can capture the results in a list assignment:
($first, $second) = $str =~ /(.*) is.*(b.*)\./;
print "$first $second\n";
# prints "Perl bioinformatics"
print("##################################################\n");

$str = "Perl is a programming language used for bioinformatics.";
$str =~ /(P.*l)/;
$word = $1;
print "$word\n"; # prints "Perl is a programming l"
$str =~ /(P.*?l)/;
$word = $1;
print "$word\n"; # prints "Perl"
$str =~ /\b(u.*?)\b/;
$word = $1;
print "$word\n"; # prints "used"
print("\n##################################################\n");

@A = qw / ATGGCT    CCCCGGTAT      GCAGTGG /;
for (@A) {
	($first, $second) = /(.+)GG(.+)/;
	print "$first $second\n" if ($first and $second);
}
print("\n##################################################\n");

$string =~ /REGEXP/;
# $` = part of string to the left of the match
# $& = part of string matched by the regular expression REGEXP
# $’ = part of string the the right the match
$string = "ATCGCAT";
$string =~ /T.G.A/;
print "left part: $` \n";
print "match: $& \n";
print "right part: $' \n";
print("\n##################################################\n");

$string = "ATCGCATGGAA";
$string =~ /T.G/g;
print "$& ends at position ", pos($string)-1, "\n";
$string =~ /T.G/g;
print "$& ends at position ", pos($string)-1, "\n";

week3_3_Regex_scr0.pl

#!/usr/bin/perl
use strict;
use warnings;
my $string = "Several rapidly developing RNA interference (RNAi)
methodologies hold the promise to selectively inhibit gene expression in
mammals. RNAi is an innate cellular process activated when a
double-stranded RNA (dsRNA) molecule of greater than 19 duplex
nucleotides enters the cell, causing the degradation of not only the
invading dsRNA molecule, but also single-stranded (ssRNAs) RNAs of
identical sequences, including endogenous mRNAs.";
# find all words containing "RNA"
while ( $string =~ /(\w*RNA\w*)/g ) {
	print "$1\n";
}
exit;

week3_4_Regex_scr1.pl

#!/usr/bin/perl
use strict;
use warnings;
my $string = "Several rapidly developing RNA interference (RNAi)
methodologies hold the promise to selectively inhibit gene
expression in mammals. RNAi is an innate cellular process activated when a
double-stranded RNA (dsRNA) molecule of greater than 19 duplex
nucleotides enters the cell, causing the degradation of not only
the invading dsRNA molecule, but also single-stranded (ssRNAs) RNAs
of identical sequences, including endogenous mRNAs.";
# find all words containing "RNA"
while ( $string =~ /(\w+RNA\w+)/g ) {
	print "$1\n";
}
exit;

week3_5_Regex_scr2.pl

#!/usr/bin/perl
use strict;
use warnings;
my $string = "Several rapidly developing RNA interference (RNAi)
methodologies hold the promise to selectively inhibit gene
expression in mammals. RNAi is an innate cellular process activated when a
double-stranded RNA (dsRNA) molecule of greater than 19 duplex
nucleotides enters the cell, causing the degradation of not only
the invading dsRNA molecule, but also single-stranded (ssRNAs) RNAs
of identical sequences, including endogenous mRNAs.";
# find all words containing "RNA"
while ( $string =~ /(\S+RNA\S+)/g ) {
	print "$1\n";
}
exit;

week3_6_Regex_scr3.pl

#!/usr/bin/perl
print ("\nEnter string or ctrl-D to quit\n");
print ("Square brackets indicate text that matched pattern\n\n");
$prompt = "test> ";
print $prompt;
while(<STDIN>) {
	chomp;
	if(/TAG/) {
		print("$`\[$&]$'\n");
	}
	else {
		print("no match\n");
	}
	print $prompt;
}
exit;

week3_7_Regex_scr4.pl

#!/usr/bin/perl
use strict;
use warnings;
my $string = "Several rapidly developing RNA interference (RNAi)
methodologies hold the promise to selectively inhibit gene expression in
mammals. RNAi is an innate cellular process activated when a
double-stranded RNA (dsRNA) molecule of greater than 19 duplex
nucleotides enters the cell, causing the degradation of not only the
invading dsRNA molecule, but also single-stranded (ssRNAs) RNAs of
identical sequences, including endogenous mRNAs.";
# find all words containing "RNA"
while ( $string =~ /(\S+RNA\S+)/g ) {
	print "$1 ends at position ", pos($string)-1, "\n";
}
exit;

week4_10_IO_Operations.pl

my $info = << 'EOF';
INPUT PIPE: "<" redirects standard input to a file:
	% readname.pl < infile
OUTPUT PIPE: ">" redirects standard output to a file:
	% readname.pl < infile > outfile
EOF
print($info);
print("##################################################\n");

open INFO, "< infile" or die "can't open datafile: $!"; 
# Read: Open file for reading.

open RESULTS,"> runstats" or die "can't open runstats: $!"; 
# Write: Open file for writing (If file exists the file will be recreated).

open LOG, ">> logfile " or die "can't open logfile: $!"; 
# Append: Open file for expanding (If file does not exist the file will be created).
print("##################################################\n");

week4_11_IO_Operations_scr1.pl

#!/usr/bin/perl
# Ask the user for the filename of the file containing
# the protein sequence data, and collect it from the keyboard

print "Please type the filename of the protein sequence data: ";
# STDIN is "standard input" file handle
# STDIN is automatically opened
$proteinfilename = <STDIN>; # get the next line from keyboard
# Remove the newline from the protein filename
chomp $proteinfilename;

# open the file, or exit
unless ( open(PROTEINFILE, $proteinfilename) ) {
	print "Cannot open file \"$proteinfilename\"\n\n";
	exit;
}

# Read the protein sequence data from the file, and store it
# into the array variable @protein

@protein = <PROTEINFILE>; # note: reads in the whole file!

# Close the file - we've read all the data into @protein now.
close PROTEINFILE;

# Put the protein sequence data into a single string, as it's easier
# to search for a motif in a string than in an array of
# lines (what if the motif occurs over a line break?)
$protein = join( '', @protein);
# Remove whitespace
$protein =~ s/\s//g;
# In a loop, ask the user for a motif, search for the motif,
# and report if it was found.
# Exit if no motif is entered.
do {
	print "Enter a motif to search for: ";
	$motif = <STDIN>;

	# Remove the newline at the end of $motif
	chomp $motif;
	
	# Look for the motif
	if ( $protein =~ /$motif/ ) {
		print "I found it!\n\n";
	} else {
		print "I couldn't find it.\n\n";
	}

# exit on an empty user input
} until ( $motif =~ /^\s*$/ );
# exit the program
exit;

week4_12_Reading_Frames.pl

#1
#2
#3

week4_1_Operators_Conditionals.pl

$a = 4;
$b = 5;

print("Arithmetic Operators for \$a=$a and \$b=$b \n");
$add = $a + $b;
$sub = $a - $b;
$mult = $a * $b;
$div = $a / $b;
$mod = $a % $b;
$power = $a ** $b;

print($a+$b . "\n");# print("$add\n");
print("$sub\n");
print("$mult\n");
print("$div\n");
print("$mod\n");
print("$power\n");
print("##################################################\n");

print("Equality Operators for \$a=$a and \$b=$b \n");
print("Equal == (eq) ", $a == $b, "\n");
print("Not Equal != (ne) ", $a != $b, "\n");
print("Compare <=> (cmp) " , $a <=> $b, "\n");
print("Greater Than > (gt) ", $a > $b, "\n");
print("Greater Than or Equal >= (ge) ", $a >= $b, "\n");
print("Less Than < (lt) ", $a < $b, "\n");
print("Less Than or Equal <= (le)", $a <= $b, "\n");
print("##################################################\n");

$t = true;
$f = false;

print("Logical Operators for \$t=true and \$t=false \n");
print("&& (and)", $t && $f, "\n");
print("|| (or)", $t || $f, "\n");
print("not ", not(0), "\n"); # usage make sense with if condition
print("##################################################\n");

$str1 = "ATG";
$str2 = "TGA";
$i = 5;
print("Additional Operators for \$str1=$str1, \$str2=$str2, \$i=$i \n");
print(". means concatenates two strings: ", $str1.$str2, "\n");
print("++ means increment by 1 (++\$i): ", ++$i, "\n");
print("-- means decrement by 1 (--\$i): ", --$i, "\n");
print("++ means increment by 1 (\$i--): ", $i++, "\n");
print("-- means decrement by 1 (\$i++): ", $i--, "\n");
print("##################################################\n");

$x = 12;
$y = 9;
print("Conditionals for \$str1=$str1, \$str2=$str2, \$i=$i \n");
if($x > $y){
	print "$x > $y";
}
elsif($x < $y){
	print "$x < $y";
}
else{
	print "$x == $y";
}
print("\n")
print("##################################################\n");

week4_2_Subroutines_scr1_min.pl

#!/usr/bin/perl
use strict;
use warnings;

# File: min.pl
my $a = <STDIN>; chomp $a;
my $b = <STDIN>; chomp $b;
my $small = min($a, $b);

print "min of $a and $b is $small\n";

exit;

sub min {
	my ($n, $m) = @_; # @_ is the array of parameters
	if ($n < $m) { 
		return $n 
	}
	else { 
		return $m 
	}
}

week4_3_Subroutines_scr2_min_max.pl

#!/usr/bin/perl
use strict;
use warnings;

# File: min_max.pl
## Subroutines can return lists
my $a = <STDIN>; chomp $a;
my $b = <STDIN>; chomp $b;
my ($small, $big) = min_max($a, $b);

print "max of $a and $b is $big\n";
print "min of $a and $b is $small\n";

exit;

sub min_max {
	my ($n, $m) = @_; # @_ is the array of parameters
	if ($n < $m) { 
		return ($n, $m) 
	}
	else { 
		return ($m, $n) 
	}
}

week4_4_Subroutines_scr3_passing_args.pl

@a = qw/ This will all /;
$b = "end";
@c = qw/ up together /;
@c = foo(@a, $b, @c);

print "@c\n";

sub foo {
	my @args = @_;
	return @args;
}
print("##################################################\n");

print("First Attempt\n");
@array = qw/asd qwer zxc/;
$aref = \@array; # $aref now holds a reference to @array
$xy = $aref; # $xy now holds a reference to @array
print(@array, "\n");
print($aref, "\n");
print($xy, "\n");
print("##################################################\n");

print("Second Attempt\n");
#Lines 2 and 3 working together do the same thing as line 1
$aref = [ 1, 2, 3 ];
@array = (1, 2, 3);
$aref = \@array;
print($aref, "\n");
print(@array, "\n");
print($aref, "\n");
print("##################################################\n");

print("Dereferencing\n");
print($aref->[3], "\n"); # print(${$aref}[3], "\n");

week4_5_Subroutines_scr4_passing_by_reference.pl

#!/usr/bin/perl -w
# A driver program to test a
# subroutine that
# passes by reference

use strict;
use warnings;

my @i = ('1', '2', '3');
my @j = ('a','b','c');

print "In main program before calling subroutine: i = " . "@i\n";
print "In main program before calling subroutine: j = " . "@j\n";

reference_sub(\@i, \@j);

print "In main program after calling subroutine: i = " . "@i\n";
print "In main program after calling subroutine: j = " . "@j\n";

exit;

sub reference_sub {
	my ($i, $j) = @_;
	print "In subroutine : i = " . "@$i\n";
	print "In subroutine : j = " . "@$j\n";
	push(@$i, '4');
	shift(@$j);
}

week4_6_Subroutines_scr5_arrays_references.pl

@a = qw/ This will all /;
$b = "end";
@c = qw/ up together /;

# this passes in references to the arrays
bar(\@a, $b, \@c); # \@a is a reference (pointer) to @a

sub bar {
	my ($x, $b, $z) = @_;
	# @_ has three items
	# dereference first argument
	my @A = @$x; # @$x is the array referenced by $x
	# dereference third argument
	my @C = @$z;
	print "@A\n";
	print "$b\n";
	print "@C\n";
}

week4_7_Variable_Scope.pl

my @seq_list = qw/ATT TTT GGG/;
my $sequence = "NNN";

for my $sequence (@seq_list){
	$sequence .= "TAG";
	print "$sequence\n";
}
print "$sequence\n";

week4_8_IO.pl

my $info = << 'EOF';
% means console
Perl has two simple, built-in ways to open files:
	-- the shell way for convenience
		% myprogram < inputfile
		% myprogram > outputfile
		% myprogram >> outputfile
		% myprogram | otherprogram
		% otherprogram | myprogram
	-- the C way for precision.
		% myprogram file1 file2 file3
Redirecting Standart I/O
	INPUT PIPE: "<" redirects standard input to a file:
		% readname.pl < infile
	OUTPUT PIPE: ">" redirects standard output to a file:
		% readname.pl < infile > outfile
EOF
print($info);
print("##################################################\n");

print("Input from Keyboard\n");
#!/usr/bin/perl
use strict;
use warnings;
# File: readname.pl

# Read in name and age
print "Enter your name: ";
my $name = <>; # "<>" reads one line from "standard input"
chomp $name; # chomp deletes any newlines from end of string

print "Enter your age: ";
my $age = <>;
chomp $age;

print "Hello, $name! ";
print "On your next birthday, you will be ", $age+1, ".\n";


print("##################################################\n");

print("Input from File\n");
my $info2 = << 'EOF2';
To do that do this:
1- Create file named infile and write NAME YOURNAME as first line, AGE as second line;
	% cat infile
	NAME YOURNAME
	AGE
2- Call the SCRIPTNAME.pl with infile (week4_9_IO_readname_from_file.pl)
	% SCRIPTNAME.pl < infile
EOF2
print($info2);
print("##################################################\n");

exit;

week4_9_IO_readname_from_file.pl

#!/usr/bin/perl
use strict;
use warnings;
# File: readname.pl

# Read in name and age
# print "Enter your name: ";
my $name = <>; # "<>" reads one line from "standard input"
chomp $name; # chomp deletes any newlines from end of string

# print "Enter your age: ";
my $age = <>;
chomp $age;

print "Hello, $name! ";
print "On your next birthday, you will be ", $age+1, ".\n";
exit;