I have the following program "Extract.pl", which opens a file, finds the lines containing "warning....", "info...", "disabling..." then counts and prints the value and number of them. It is working ok.
What I want to do is to create command line arguments for each of the 3 matches - warning, disabling and infos and then run either of them from the command prompt.
Here is the code:
#!/usr/bin/perl
use strict;
use warnings;
my %warnings = ();
my %infos = ();
my %disablings = ();
open (my $file, '<', 'Warnings.txt') or die $!;
while (my $line = <$file>) {
if($line =~ /^warning ([a-zA-Z0-9]*):/i) {
++$warnings{$1};
}
if($line =~ /^disabling ([a-zA-Z0-9]*):/i) {
++$disablings{$1};
}
if($line =~ /^info ([a-zA-Z0-9]*):/i) {
++$infos{$1};
}
}
close $file;
foreach my $w (sort {$warnings{$a} <=> $warnings{$b}} keys %warnings) {
print $w . ": " . $warnings{$w} . "\n";
}
foreach my $d (sort {$disablings{$a} <=> $disablings{$b}} keys %disablings) {
print $d . ": " . $disablings{$d} . "\n";
}
foreach my $i (sort {$infos{$a} <=> $infos{$b}} keys %infos) {
print $i . ": " . $infos{$i} . "\n";
}
The builtin special array #ARGV holds all command line arguments to the script, excluding the script file itself (and the interpreter, if called as perl script.pl). In the case of a call like perl script.pl foo bar warnings, #ARGV would contain the values 'foo', 'bar', and 'warnings'. It's a normal array, so you could write something like (assuming the first argument is one of your options):
my ($warning, $info, $disabling);
if ($ARGV[0] =~ /warning/i) { $warning = 1 }
elsif ($ARGV[0] =~ /info/i) { $info = 1 }
elsif ($ARGV[0] =~ /disabling/i) { $disabling = 1 }
# [...] (opening the file, starting the main loop etc...)
if ( $warning and $line =~ /^warning ([a-zA-Z0-9]*)/i ) {
++$warnings{$1};
}
elsif ( $info and $line =~ /^info ([a-zA-Z0-9]*)/i ) {
++$infos{$1};
}
elsif ( $disabling and $line =~ /^disabling ([a-zA-Z0-9]*)/i ) {
++$disablings{$1};
}
I created flag variables for the three conditions before the main loop that goes through the file to avoid a regex compilation on every line of the file.
You could also use the Getopt::Long or Getopt::Std modules. These provide easy and flexible handling of the command line arguments.
Related
i have two files . one is user's input file and another file is original config file. After comparing two files , do add/delete functions in my original config file.
user's input file: (showing line by line)
add:L28A:Z:W #add--> DID ID --> Bin ID
del:L28C:B:Q:X:
rpl:L38A:B:M:D:
original input file
L28A:B:Q:M:X:
L28C:B:Q:M:X:
L38A:B:Q:M:X:
based on user's input file , first is doing add function second is delete function and third is replace function.
so output for original input txt file should show:
L28A:B:Q:M:X:Z:W
L28C:M:
L38A:B:M:D:
but my code is showing :
L28A:B:Q:M:X:
L28C:B:Q:M:X:
L38A:B:Q:M:X:
L28A:B:Q:M:X:Z:W
L28C:M:
L38A:B:M:D:
how can i replace above three lines with new modify lines?
use strict;
use warnings;
use File::Copy;
use vars qw($requestfile $requestcnt $configfile $config2cnt $my3file $myfile3cnt $new_file $new_filecnt #output);
my $requestfile = "DID1.txt"; #user's input file
my $configfile = "DID.txt"; #original config file
my $new_file = "newDID.txt";
readFileinString($requestfile, \$requestcnt);
readFileinString($configfile, \$config2cnt);
copy($configfile, $new_file) or die "The copy operation failed: $!";
while ($requestcnt =~ m/^((\w){3})\:([^\n]+)$/mig) #Each line from user request
{
my $action = $1;
my $requestFullLine = $3;
while ($requestFullLine =~ m/^((\w){4})\:([^\n]+)$/mig) #Each line from user request
{
my $DID = $1; #DID
my $requestBinList = $3; #Bin List in user request
#my #First_values = split /\:/, $requestBinList;
if ($config2cnt =~ m/^$DID\:([^\n]+)$/m) #configfile
{
my $ConfigFullLine = $1; #Bin list in config
my $testfile = $1;
my #First_values = split /\:/, $ConfigFullLine;
my #second_values = split /\:/, $requestBinList;
foreach my $sngletter(#second_values) # Each line from user request
{
if( grep {$_ eq "$sngletter"} #First_values)
{
print " $DID - $sngletter - Existing bin..\n\n";
}
else
{
print "$DID - $sngletter - Not existing bin..\n\n";
}
}
print "Choose option 1.Yes 2.No\n";
my $option = <STDIN>;
if ($option == 1) {
open(DES,'>>',$configfile) or die $!;
if($action eq 'add')
{
$ConfigFullLine =~ s/$/$requestBinList/g;
my $add = "$DID:$ConfigFullLine";
print DES "$add\n" ;
print"New Added Bin Valu $add\n\n";
}
if ( $action eq 'del')
{
foreach my $sngletter(#second_values){
$ConfigFullLine =~ s/$sngletter://g;
}
print DES "$DID:$ConfigFullLine\n";
print "New Deleted Bin Value $DID:$ConfigFullLine\n\n";
}
if ( $action eq 'rpl')
{
my $ConfigFullLine = $requestBinList;
my $replace = "$DID:$ConfigFullLine";
print DES "$replace\n";
print"Replace Bin Value $replace\n\n";
}
}
elsif ($option == 2)
{
print"Start from begining\n";
}
else
{
print "user chose invalid process or input is wrong\n";
}
}
else
{
print "New DID $DID detected\n";}
}
}
sub readFileinString
{
my $File = shift;
my $string = shift;
use File::Basename;
my $filenames = basename($File);
open(FILE1, "<$File") or die "\nFailed Reading File: [$File]\n\tReason: $!";
read(FILE1, $$string, -s $File, 0);
close(FILE1);
}
The problem is here:
open(DES,'>>',$configfile) or die $!;
You open your file for appending. So you get the original data, followed by your edited data.
Update: It appears that you have a working solution now, but I thought it might be interesting to show you how I would write this.
This program is a Unix filter. That is, it reads from STDIN and writes to STDOUT. I find that far more flexible than hard-coded filenames. You also don't have to explicitly open files - which saves time :-)
It also takes a command-line option, -c, telling it which file contains the edit definitions. So it is called like this (assuming we've called the program edit_files:
$ edit_files -c edit_definitions.txt < your_input_file > your_output_file
And here's the code.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Std;
my %opts;
getopts('e:', \%opts);
my %edits = read_edits($opts{e});
while (<>) {
chomp;
my ($key, $val) = split /:/, $_, 2; #/ stop faulty syntax highlight
if (!exists $edits{$key}) {
print "$_\n";
next;
}
my $edit = $edits{$key};
if ($edit->[0] eq 'add') {
print "$_$edit->[1]\n";
} elsif ($edit->[0] eq 'del') {
$val =~ s/$_:// for split /:/, $edit->[1]; #/
print "$key:$val\n";
} elsif ($edit->[0] eq 'rpl') {
print "$key:$edit->[1]\n";
} else {
warn "$edit->[0] is an invalid edit type\n";
next;
}
}
sub read_edits {
my $file = shift;
open my $edit_fh, '<', $file or die $!;
my %edits;
while (<$edit_fh>) {
chomp;
# Remove comments
s/\s*#.*//; #/
my ($type, $key, $val) = split /:/, $_, 3; #/
$edits{$key} = [ $type, $val ];
}
}
The script is printing the amount of input lines, I want it to print the amount of input lines that are present in another file
#!/usr/bin/perl -w
open("file", "text.txt");
#todd = <file>;
close "file";
while(<>){
if( grep( /^$_$/, #todd)){
#if( grep #todd, /^$_$/){
print $_;
}
print "\n";
}
if for example file contains
1
3
4
5
7
and the input file that will be read from contains
1
2
3
4
5
6
7
8
9
I would want it to print 1,3,4,5 and 7
but 1-9 are being printed instead
UPDATE******
This is my code now and I am getting this error
readline() on closed filehandle todd at ./may6test.pl line 3.
#!/usr/bin/perl -w
open("todd", "<text.txt");
#files = <todd>; #file looking into
close "todd";
while( my $line = <> ){
chomp $line;
if ( grep( /^$line$/, #files) ) {
print $_;
}
print "\n";
}
which makes no sense to me because I have this other script that is basically doing the same thing
#!/usr/bin/perl -w
open("file", "<text2.txt"); #
#file = <file>; #file looking into
close "file"; #
while(<>){
$temp = $_;
$temp =~ tr/|/\t/; #puts tab between name and id
my ($name, $number1, $number2) = split("\t", $temp);
if ( grep( /^$number1$/, #file) ) {
print $_;
}
}
print "\n";
OK, the problem here is - grep sets $_ too. So grep { $_ } #array will always give you every element in the array.
At a basic level - you need to:
while ( my $line = <> ) {
chomp $line;
if ( grep { /^$line$/ } #todd ) {
#do something
}
}
But I'd suggest instead that you might want to consider building a hash of your lines instead:
open( my $input, '<', "text.txt" ) or die $!;
my %in_todd = map { $_ => 1 } <$input>;
close $input;
while (<>) {
print if $in_todd{$_};
}
Note - you might want to watch for trailing linefeeds.
I have a file with almost 1,500 names of Marvel heroes, each name in new line. I have to ask user what his favourite hero is and find out if it's a hero from the list or not. Here's what I have right now. It doesn't work: I can guess only the last hero from the list. For the rest it just prints that they are not on the list.
print "Whats your favourite hero?\n";
my $hero = <stdin>;
chomp $hero;
open FILE, "<list_marvel.txt";
my #marvel = <FILE>;
chomp(#marvel);
my $result = 0;
foreach (#marvel) {
if ($_ eq $hero);
}
if ($result == 1) {
print "That hero is on the list";
}
else {
print "$hero is not on the list.\n";
}
Here are two files:
-Perl code : Perl Code
-List of heroes : List
Your program has a syntax error and won't compile. It certainly won't find only the last name on the list
The main problem is that you never set $result, and if($_ eq $hero) should be something like $result = 1 if($_ eq $hero)
You must always use strict and use warnings at the top of every Perl program you write. It is an enormous help in finding straighforward problems
Here's a working version
use strict;
use warnings;
my $filename = 'list_marvel.txt';
open my $fh, '<', $filename or die qq{Unable to open "'list_marvel.txt'": $!};
print "Whats your favourite hero? ";
my $hero = <>;
chomp $hero;
my $found;
while ( <$fh> ) {
chomp;
if ( $_ eq $hero ) {
++$found;
last;
}
}
print $found ? "$hero is on the list\n" : "$hero is not on the list";
You don't set $result anywhere to true.
Make your foreach loop like this:
foreach(#marvel){
$result = $_ eq $hero;
}
or
foreach (#marvel){
$result = 1 if $_ eq $hero
}
You forgot to increment your $result. If you indent your code properly, it is easier to see.
foreach (#marvel) {
# here something is missing
if ( $_ eq $hero );
}
Add $result++ if $_ eq $hero; in the foreach.
You should always use strict and use warnings. That would have told you about a syntax error near );.
Also consider using the three argument open with lexical filehandles.
Rewritten it looks like this:
use strict;
use warnings;
use feature 'say'; # gives you say, which is print with a newline at the end
say "What's you favourite hero?";
my $hero = <STDIN>;
chomp $hero;
# alsways name variables so it's clear what they are for
my $found = 0;
# die with the reason of error if something goes wrong
open my $fh, '<', 'list_marvel.txt' or die $!;
# read the file line by line
while ( my $line = <$fh> ) {
chomp $line;
if ( $line eq $hero ) {
# increment so we know we 'found' the hero in the list
$found++;
# stop reading at the first hit
last;
}
}
close $fh;
# no need to check for 1, truth is enough
if ( $result ) {
say "That hero is on the list.";
}
else {
say "$hero is not on the list.";
}
First, you miss setting the $result at around if($_ eq $hero).
Then, you may wish to make you comparison case insensitive. This would require a regular expression, e.g.:
$result = 1 if (/^$hero$/i);
Just modified your code. After if condition increment $result. Always use use strict and use warnings and always use 3 arguments to open a file.
use strict;
use warnings;
print "Whats your favourite hero?\n";
my $hero = <stdin>;
chomp $hero;
open FILE, "<", "list_marvel.txt" or die $!;
chomp (my #marvel = <FILE>);
close FILE;
my $result = 0;
foreach my $name (#marvel)
{
if($name eq $hero)
{
$result++;
}
}
if ($result == 1)
{
print "That hero is in the list.\n";
}
else
{
print "$hero is not in the list.\n";
}
This will take a single user entry from STDIN. It will run through the file of hero names, and if one matches the user entry it will print the name and exit the loop. If the name is not found it will tell you:
use warnings;
use strict;
open my $file1, '<', 'input.txt' or die $!;
print "Enter hero: ";
chomp(my $hero = <STDIN>);
my $result = 0;
while(<$file1>){
chomp;
if (/$hero/){
print "$_\n";
$result++;
last;
}
}
print "hero not in list\n" if $result == 0;
I am new to perl and would like to do what I think is some basic string manipulation to DNA sequences stored in an rtf file.
Essentially, my file reads (file is in FASTA format):
>LM1
AAGTCTGACGGAGCAACGCCGCGTGTATGAAGAAGGTTTTCGGATCGTAA
AGTACTGTCCGTTAGAGAAGAACAAGGATAAGAGTAACTGCTTGTCCCTT
GACGGTATCTAACCAGAAAGCCACGGCTAACTACGTGCCAGCAGCCGCGG
TAATACGTAGGTGGCAAGCGTTGTCCGGATTTATTGGGCGTAAAGCGCGC
GCAGGCGGTCTTTTAAGTCTGATGTGAAAGCCCCCGGCTTAACCGGGGAG
GGTCATTGGAAACTGGAAGACTGGAGTGCAGAAGAGGAGAGTGGAATTCC
ACGTGTAGCGGTGAAATGCGTAGATATGTGGAGGAACACCAGTGGCGAAG
GCGACTCTCTGGTCTGTAACTGACGCTGAGGCGCGAAAGCGTGGGGAGCA
AACAGGATTAGATACCCTGGTAGTCCACGCCGT
What I would like to do is read into my file and print the header (header is >LM1) then match the following DNA sequence GTGCCAGCAGCCGC and then print the preceding DNA sequence.
So my output would look like this:
>LM1
AAGTCTGACGGAGCAACGCCGCGTGTATGAAGAAGGTTTTCGGATCGTAA
AGTACTGTCCGTTAGAGAAGAACAAGGATAAGAGTAACTGCTTGTCCCTT
GACGGTATCTAACCAGAAAGCCACGGCTAACTAC
I have written the following program:
#!/usr/bin/perl
use strict; use warnings;
open(FASTA, "<seq_V3_V6_130227.rtf") or die "The file could not be found.\n";
while(<FASTA>) {
chomp($_);
if ($_ =~ m/^>/ ) {
my $header = $_;
print "$header\n";
}
my $dna = <FASTA>;
if ($dna =~ /(.*?)GTGCCAGCAGCCGC/) {
print "$dna";
}
}
close(FASTA);
The problem is that my program reads the file line by line and the output I am receiving is the following:
>LM1
GACGGTATCTAACCAGAAAGCCACGGCTAACTAC
Basically I don't know how to assign the entire DNA sequence to my $dna variable and ultimately don't know how to avoid reading the DNA sequence line by line. Also I am getting this warning:
Use of uninitialized value $dna in pattern match (m//) at stacked.pl line 14, line 1113.
If anyone could give me some help with writing better code or point me in the correct direction it would be much appreciated.
Using the pos function:
use strict;
use warnings;
my $dna = "";
my $seq = "GTGCCAGCAGCCGC";
while (<DATA>) {
if (/^>/) {
print;
} else {
if (/^[AGCT]/) {
$dna .= $_;
}
}
}
if ($dna =~ /$seq/g) {
print substr($dna, 0, pos($dna) - length($seq)), "\n";
}
__DATA__
>LM1
AAGTCTGACGGAGCAACGCCGCGTGTATGAAGAAGGTTTTCGGATCGTAA
AGTACTGTCCGTTAGAGAAGAACAAGGATAAGAGTAACTGCTTGTCCCTT
GACGGTATCTAACCAGAAAGCCACGGCTAACTACGTGCCAGCAGCCGCGG
TAATACGTAGGTGGCAAGCGTTGTCCGGATTTATTGGGCGTAAAGCGCGC
GCAGGCGGTCTTTTAAGTCTGATGTGAAAGCCCCCGGCTTAACCGGGGAG
GGTCATTGGAAACTGGAAGACTGGAGTGCAGAAGAGGAGAGTGGAATTCC
ACGTGTAGCGGTGAAATGCGTAGATATGTGGAGGAACACCAGTGGCGAAG
GCGACTCTCTGGTCTGTAACTGACGCTGAGGCGCGAAAGCGTGGGGAGCA
AACAGGATTAGATACCCTGGTAGTCCACGCCGT
You can process a file with multiple entries like so:
while (<DATA>) {
if (/^>/) {
if ($dna =~ /$seq/g) {
print substr($dna, 0, pos($dna) - length($seq)), "\n";
$dna = "";
}
print;
} elsif (/^[AGCT]/) {
$dna .= $_;
}
}
if ($dna && $dna =~ /$seq/g) {
print substr($dna, 0, pos($dna) - length($seq)), "\n";
}
Your while statement reads until the end of file. That means at every loop iteration, $_ is the next line in <FASTA>. So $dna = <FASTA> isn't doing what you think it is. It is reading more than you probably want it to.
while(<FASTA>) { #Reads a line here
chomp($_);
if ($_ =~ m/^>/ ) {
my $header = $_;
print "$header\n";
}
$dna = <FASTA> # reads another line here - Causes skips over every other line
}
Now, you need to read the sequence into your $dna. You can update your while loop with an else statement. So if its a head line, print it, else, we add it to $dna.
while(<FASTA>) {
chomp($_);
if ($_ =~ m/^>/ ) {
# It is a header line, so print it
my $header = $_;
print "$header\n";
} else {
# if it is not a header line, add to your dna sequence.
$dna .= $_;
}
}
After the loop, you can do your regex.
Note: This solution assumes there is only 1 sequence in the fasta file. If you have more than one, your $dna variable will have all the sequences as one.
Edit: Adding simple a way to handle multiple sequences
my $dna = "";
while(<FASTA>) {
chomp($_);
if ($_ =~ m/^>/ ) {
# Does $dna match the regex?
if ($dna =~ /(.*?)GTGCCAGCAGCCGC/) {
print "$1\n";
}
# Reset the sequence
$dna = "";
# It is a header line, so print it
my $header = $_;
print "$header\n";
} else {
# if it is not a header line, add to your dna sequence.
$dna .= $_;
}
}
# Check the last sequence
if ($dna =~ /(.*?)GTGCCAGCAGCCGC/) {
print "$1\n";
}
I came up with a solution using BioSeqIO (and the trunc method from BioSeq from the BioPerl distribution. I also used index to find the subsequence rather than using a regular expression.
This solution does not print out the id, (line begins with >), if the subsequence was not found or if the subsequence begins at the first postion, (and thus no preceding characters).
#!/usr/bin/perl
use strict;
use warnings;
use Bio::SeqIO;
my $in = Bio::SeqIO->new( -file => "fasta_junk.fasta" ,
-format => 'fasta');
my $out = Bio::SeqIO->new( -file => '>test.dat',
-format => 'fasta');
my $lookup = 'GTGCCAGCAGCCGC';
while ( my $seq = $in->next_seq() ) {
my $pos = index $seq->seq, $lookup;
# if $pos != -1, ($lookup not found),
# or $pos != 0, (found $lookup at first position, thus
# no preceding characters).
if ($pos > 0) {
my $trunc = $seq->trunc(1,$pos);
$out->write_seq($trunc);
}
}
__END__
*** fasta_junk.fasta
>LM1
AAGTCTGACGGAGCAACGCCGCGTGTATGAAGAAGGTTTTCGGATCGTAA
AGTACTGTCCGTTAGAGAAGAACAAGGATAAGAGTAACTGCTTGTCCCTT
GACGGTATCTAACCAGAAAGCCACGGCTAACTACGTGCCAGCAGCCGCGG
TAATACGTAGGTGGCAAGCGTTGTCCGGATTTATTGGGCGTAAAGCGCGC
GCAGGCGGTCTTTTAAGTCTGATGTGAAAGCCCCCGGCTTAACCGGGGAG
GGTCATTGGAAACTGGAAGACTGGAGTGCAGAAGAGGAGAGTGGAATTCC
ACGTGTAGCGGTGAAATGCGTAGATATGTGGAGGAACACCAGTGGCGAAG
GCGACTCTCTGGTCTGTAACTGACGCTGAGGCGCGAAAGCGTGGGGAGCA
AACAGGATTAGATACCCTGGTAGTCCACGCCGT
*** contents of test.dat
>LM1
AAGTCTGACGGAGCAACGCCGCGTGTATGAAGAAGGTTTTCGGATCGTAAAGTACTGTCC
GTTAGAGAAGAACAAGGATAAGAGTAACTGCTTGTCCCTTGACGGTATCTAACCAGAAAG
CCACGGCTAACTAC
read the whole file into memory then look for the regexp
while(<FASTA>) {
chomp($_);
if ($_ =~ m/^>/ ) {
my $header = $_;
print "$header\n";
} else {
$dna .= $_;
}
}
if ($dna =~ /(.*?)GTGCCAGCAGCCGC/) {
print $1;
}
I'm writting a small server with perl. There is some small problem. When the client give me a sentence like this "op:xxx:xxx:xxx", I'll get op. then do things depending on what op is. It works will if the op is adduser and so on. (I use if $op eq "adduser"...)
But when I get a "getList:xxx:xxx" and I have get the $op = getList, it can't pass it like "if $op eq "getList"". I know, it must be my mistake. But I just can't find it.
thank you for everyone.
use warnings;
use strict;
package MyPackage;
use base qw(Net::Server);
our %data_base;
our %tag_base;
sub list {
my %resault;
foreach ( keys %tag_base) {
print STDERR $_ . "1";
my #tags = split /:/, $tag_base{$_};
foreach ( #tags) {
$resault{$_} ++;
}
}
my #tags;
foreach ( keys %resault) {
push #tags, "$_,$resault{$_}";
}
$_ = join ";", #tags;
print ;
print STDERR ;
}
sub users {
my $topic = shift;
my #users;
foreach ( keys %tag_base) {
push #users, $_ if $tag_base{$_} =~ /$topic/;
}
$_ = join ";", #users;
print ;
}
sub process_request {
my $self = shift;
my $person;
my #info;
while (<STDIN>) {
my #gets = split /:/, $_;
print STDERR "#gets\n";
# $data_base{shift #person} = join ":", #person;
my $op = shift #gets;
$op =~ s/\s//;
print STDERR $op . "\n";
if ( $op eq "adduser") {
my $user_name = shift #gets;
if ( exists $data_base{$user_name}) {
print "already_exist";
} else {
$data_base{$user_name} = join ":", #gets;
print "addUserSu";
}
} elsif ( $op eq "login") {
my $login_name = shift #gets;
my $login_pw = shift #gets;
if ( defined $data_base{$login_name}) {
$person = $data_base{$login_name};
#info = split /:/, $person;
$info[0] =~ s/\s+//;
if ($login_pw eq $info[0]) {
print "$person";
} else {
print "/$info[0]/";
}
} else {
print "unexist_user";
}
} elsif ( $op eq "addTag") {
my $tag_user = shift #gets;
$tag_base{$tag_user} = join ":", #gets;
print "addTagSu";
} elsif ( $op eq "getList") {
print STDERR "right";
&list;
} elsif ( $op eq "getUsers") {
&users;
}
}
}
MyPackage->run(port => 13800);
I can see two (simple) reasons this might fail:
$op =~ s/\s//;
You only remove one whitespace: The first one. If your intention is to strip all whitespace, you'd want s/\s+//g.
And second:
Random capital letters in strings, variable names and commands is Evil. eq is case sensitive, so if $op is "getlist", then if ($op eq "getList") will be false. Unless capitalization is important to you, you could do if (lc($op) eq "getlist").
Without sample input, expected output and actual output, this is however nothing more than guesswork.
Also, as a debug statement, this is useless:
print STDERR $op . "\n";
That is easily confused and overlooked. For example, if $op is empty, it just produces a blank line in your error log. Use:
print STDERR "OP is: '$op'\n";
Now you will be able to identify the line where $op should appear, and you will be more easily see whitespace surrounding it.
You are reading strings without chomping them.
i.e.
When you run your code :
addtag:fred:barney
The input is stored as fred => "barney\n"
when you getList, the output is :
barney
,1;
I suspect the client is expecting 1 line of output that reads :
barney,1;
So, just add a chomp in your code here :
while (<STDIN>) {
chomp;
my #gets = split /:/, $_;