Posts by d5e5

I don't understand why it doesn't work for you. It does for me. Make sure you are calling the procedure by the same name as the procedure name that you create. (I made that mistake in the script posted above, creating sp_oper but calling oper, but after dropping oper and fixing the statement to call sp_oper the above script still gives me the expected output of 20.)

The only thing I can suggest is to add $DBI::errstr to the statement that calls sp_oper so it will give you more specific error information. Change the statement as follows: $dbh->do("CALL sp_oper(15, \@b, '+')") or die "cannot execute or call this procedure: $DBI::errstr\n";

Since the docs don't say you have to have any specific extension for your file name, I guess you can have any that you want. Why not try it with a simple example?

I haven't used Storable and am not an expert, but I see that the docs give simple examples storing the contents of hashes. If you run the following:

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

use Data::Dumper;
use Storable;
my %table = (cat => 'animal',
             dog => 'animal',
             carrot => 'vegetable',
             granite => 'mineral');

store \%table, 'avm.txt';
my $hashref = retrieve('avm.txt');

#Dump the contents of the $hashref
print Dumper($hashref);

It works fine, but if you use a text editor to view the 'avm.txt' file you will see that it has a lot of unprintable characters, so adding the '.txt' extension could be kind of misleading.

...d5e5, so by using the filename from the end of the src URL, that should solve the issue with the incorrect filetypes, yes?

Yes. Assuming that the src URL ends in an extension that correctly identifies the file type, you can capture the file name (or just the extension, .png or .jpg, if you prefer.)

You need to change the following statement from

open my $IMAGE, '>>', "$title.png"
        or die "Cannot create file!";

to

open my $IMAGE, '>>', "$title.$ext"
        or die "Cannot create file!";

after declaring a variable called $ext and capturing the correct file extension into it.

How do you capture the file extension into your $ext variable? See the following snippet from your script, which I have modified slightly. Notice that the regular expression (or regex) now contains two sets of parentheses instead of one. The second set of parentheses captures the end of the src url into $2, which we save to $ext.

# Obtains all individual comic data
sub getComicData {
    my $siteData = get("$sitePrefix$current/");
    my @data = split /\n/, $siteData;
    my $ext;
    foreach (@data) {
        if (/http:\/\/xkcd.com\/(\d+)\//) {
            $current = $1;
        }
        if (/src="(http:\/\/imgs.xkcd.com\/comics\/.+(\.\w{3}))"/) {
            $currentUrl = $1;
            $ext = $2;
            print "$currentUrl has the following extension: $ext", "\n";
            sleep(3);
            if (/alt="(.+?)"/) {
                $title = $1;
                $title =~ s/&#(\d+);/chr($1)/ge;
            $title = "House of Pancakes" if $current == 472;  # Color title on comic 472 with weird syntax
            }
            if (/title="(.+?)"/) {    #title commonly know as 'alt' text
                $alt = $1; …

Read about edit-in-place. I don't have time right now to customise but here is an old example I've used before for editing a file, saving a backup, and the edited file automatically replaces the original.

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

my $filename = '/home/david/Programming/Perl/data/var.txt';

#So you can use diamond operator and inplace editing
push @ARGV, $filename;

#Enable inplace editing. Copy of input file saved as 'var.txt.bk'
$^I = ".bk"; 

my $replaced = 0;

while(<>){
    chomp;
    if ($replaced == 0
        and s/the line to be replaced/this is the new line/){
        $replaced++;
    }
    print "$_\n";
}

The way you were setting the @b session variable somehow didn't work so the INOUT parameter @b probably contained NULL, and adding any number to NULL gives NULL. That's my guess, but I'm not sure. Anyway, the following works for me.

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

use DBI;

my $dbh = DBI->connect("DBI:mysql:daniweb","david", "dogfood",{ PrintError => 0}) || die $DBI::errstr;

my $drop_if_exists = qq(DROP PROCEDURE IF EXISTS sp_oper;);
$dbh->do($drop_if_exists) || die "Error dropping procedure: $DBI::errstr\n";

my $create_procedure = qq{
	CREATE PROCEDURE sp_oper(IN a FLOAT, INOUT b FLOAT, IN oper VARCHAR(1))
BEGIN
#Too confusing to name procedure same as IN oper parameter
#so rename either procedure or parameter. I named procedure 'sp_oper'.
  CASE oper
  WHEN '+' THEN SET b := a + b;
  WHEN '-' THEN SET b := a - b;
  WHEN '*' THEN SET b := a * b;
  WHEN '/' THEN SET b := a / b;
  WHEN '%' THEN SET b := a % b;
  WHEN '^' THEN SET b := POW(a, b);
  ELSE SET b := a;
  END CASE;
  # SELECT b; #Not needed
  END 
};
$dbh->do($create_procedure) || die "Error creating procedure: $DBI::errstr\n";

#$dbh->do('SELECT @b = 5;') || die "$DBI::errstr\n"; #Does not work!

#Set session variable as follows:
my $param = 5;
$dbh->do(qq{SET \@b = ? }, undef, $param);

#Escape @b with backslash so Perl won't interpolate
$dbh->do("CALL oper(15, \@b, '+')") or die "cannot execute or call this procedure";
my ($value_from_sp) = $dbh->selectrow_array('SELECT @b');
print "Value from sp_oper is $value_from_sp\n";
$dbh->disconnect || die "Failed to disconnect\n";

Creating the simpleproc procedure from Perl works OK for you, so assuming the simpleproc already exists on your database, you can call it and print the value of the OUT parameter doing something like this:

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

use DBI;

my ($dbh, @a, $nbr, $sql);

$dbh=DBI->connect('dbi:mysql:daniweb','david','dogfood') || 
   die "Error opening database: $DBI::errstr\n";

$sql = "call simpleproc(\@a)";
$dbh->do($sql);
$nbr = $dbh->selectrow_array('SELECT @a');
print "Received nbr from simpleproc is $nbr\n";

$dbh->disconnect || die "Failed to disconnect\n";

I got this from the "workaround" posted at the end of this thread at StackOverflow.

You may also try substituting the following snippet to get the field name as well as the value:

$sql = "call simpleproc(\@a)";
$dbh->do($sql);
$hash_ref = $dbh->selectrow_hashref('SELECT @a');
my ($hdr) = keys %{$hash_ref};
$nbr = $hash_ref->{$hdr};
print "FieldName is $hdr\n";
print "Returned value is $nbr\n";
use Data::Dumper;
print Dumper($hash_ref);

Instead of taking filename from alt take it from the end of the src URL.

# Obtains all individual comic data
sub getComicData {
    my $siteData = get("$sitePrefix$current/");
    my @data = split /\n/, $siteData;
    foreach (@data) {
        if (/http:\/\/xkcd.com\/(\d+)\//) {
            $current = $1;
        }
        
        #Instead of taking filename from alt
        #take it from the end of the src URL
        if (/src="(http:\/\/imgs.xkcd.com\/comics\/(.+\.\w{3}))"/) {
            $currentUrl = $1;
            #if (/alt="(.+?)"/) {
            #    $title = $1;
            #    $title = "House of Pancakes" if $current == 472;  # Color title on comic 472 with weird syntax
            #}
            $title = $2;
            say "File to save: $title";
            if (/title="(.+?)"/) {    #title commonly know as 'alt' text
                $alt = $1;
            }
        }
    }
}

I don't see a connect statement in your script. The following works for me.

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

use DBI;
my ($dbh, $sql, $sth, $msg);

$dbh=DBI->connect('dbi:mysql:daniweb','david','dogfood') || 
   die "Error opening database: $DBI::errstr\n";
   
my $create_procedure = qq{
   CREATE PROCEDURE simpleproc ()
   BEGIN
   SELECT 'helloworld' As Messgae;
   END
};

$dbh->do($create_procedure);
$sql = "CALL simpleproc()";
$sth = $dbh->prepare($sql);
$sth->execute();

while (( $msg) = $sth ->fetchrow_array) {
   print "$msg \n";
}


$sth->finish();

$dbh->disconnect || die "Failed to disconnect\n";

Running the above in Perl gives only helloworld as output. However if you log into a MySQL client directly and call your procedure you will see it is indeed there:

mysql> use daniweb;
Reading table information for completion of table and column names
You can turn off this feature to get a quicker startup with -A

Database changed
mysql> call simpleproc();
+------------+
| Messgae    |
+------------+
| helloworld | 
+------------+
1 row in set (0.00 sec)

Query OK, 0 rows affected (0.00 sec)

I was told that there are four python string delimiters but I can only think of three, ', ", & """. What is that last one? I searched google but with no luck.

1. single quote '
2. double quote "
3. triple double quote """
4. triple single quote '''

http://docs.python.org/release/1.5.1p1/tut/strings.html

(also how do i properly wrap my code in the [code] as this is my first post with a code snippet

[CODE]#First line of code
.
.
.
.
#Last line of code[/CODE]

This works for me in a Linux environment:

perl -n -i.bak -e '$r=1 if m/<process-type="Remote">/;$m=1 if $r && m/<\/module-data>/;print;if ($r and $m){print "blah\n" x 7;($r,$m)=(0,0);}' file.txt

file.txt now contains:

--------------------------FILE------------------------------------------
<process-type="Local">
               <module-data>
               </module-data>
<process-type="Remote">
               <module-data>
               </module-data>
blah
blah
blah
blah
blah
blah
blah
--------------------------FILE------------------------------------------

Here is an example of a slightly different way of assigning the first (and only) element retrieved by fetchrow_array to a scalar variable without having to declare an array variable as an intermediary:

#The following query should return only one row containing one integer.
$sth=$dbh->prepare("SELECT COUNT(*) FROM tasks;") ||
   die "Prepare failed: $DBI::errstr\n";

$sth->execute() ||
   die "Couldn't execute query: $DBI::errstr\n";

my ($nbr) = $sth->fetchrow_array; #Assign result to scalar variable (note parentheses)
print "The number of tasks is $nbr \n";

That would work, I guess. Since there is only one element in the array I would do it as follows because to me it looks clearer to understand at a glance that you are assigning one element of an array to one scalar variable:

my @record = $sth->fetchrow_array; #Assign result to array variable
my $result = $record[0];
print "The result of query is $result \n";

Sorry, I probably can't help you because my platform is Linux and I don't have Excel, etc. so can't test your script. I really don't see anything wrong with line 84 of your script.

Can you recreate the error in a simpler script without all the presumably irrelevant (irrelevant to the "uninitialized value $VarComparison error") stuff?

An example of a query that returns only one row consisting of one column:

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

use warnings;
use strict;
use DBI;
my $pwd = 'dogfood';
my ($dbh, $sth);

$dbh=DBI->connect('dbi:mysql:daniweb','david',$pwd) || 
   die "Error opening database: $DBI::errstr\n";

#The following query should return only one row containing one integer.
$sth=$dbh->prepare("SELECT 5 as lucky_number;") ||
   die "Prepare failed: $DBI::errstr\n";

$sth->execute() ||
   die "Couldn't execute query: $DBI::errstr\n";

my @record = $sth->fetchrow_array; #Assign result to array variable
print "The result of query is $record[0] \n";

$sth->finish();
$dbh->disconnect || die "Failed to disconnect\n";

I don't know how to do it with a one-liner.

The "add only if not already present" requirement is much more easily done by building a hash instead of an array.

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

my %emails = ('sam@email.com' => undef,
              'john@email.com' => undef,
              'jenifer@email.com' => undef);#Hash of emails

while (<DATA>){
    chomp;
    s/^Zip_Name: //;#Remove unwanted text at beginning of $_ (default record variable)
    $emails{$_} = undef; #Email as key in hash automatically unique.
}

say "Hash contains the following emails:";
say foreach (sort keys %emails);

__DATA__
Zip_Name: jenni@email.com
Zip_Name: sam@email.com
Zip_Name: dave@email.com
Zip_Name: john@email.com

This gives the following output:

Hash contains the following emails:
dave@email.com
jenifer@email.com
jenni@email.com
john@email.com
sam@email.com

substr takes an expression (here $str), an offset (index of starting character) and length. You need to keep in mind that offset is zero based.

In your example, you take the first 3 characters ("Jan"), then concatenate that with the characters at index 4 and 5 (" "), which you strip of the spaces (""), then the characters at index 7,8 ("11").

Perl is an excellent language in that you don't need to "translate" what you want to do with how you need to write it. If what you want is to "strip all whitespace from $str" then simply write

$str =~ s/\s+/g

(the g modifier means the action will be repeated as long as necessary. If your intention is different, a different solution can be used.

Excellent alternative @erezschatz, and good explanation of the original problem, except for when you say

the characters at index 4 and 5 (" ")

because the characters at
index 4 and 5 look to me like "8 " as the following demonstrates:

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

#The following is the OP's example (typos $Str corrected to $str)
my $str = "Jan 8 11"; # Jan, 8th 11 o'clock
#print substr($str, 0,3) . substr($str, 4,2)=~s/^\s+// . substr($str, 7,2) . "\n";

#OK. What is the value of substr($str, 4,2) without the substitution?
my $middle_substring = substr($str, 4,2);
say "*****$middle_substring*****"; #Prints *****8 *****! Why?

#Let's print what the middle part of the above gives you.
my $middle_substring_stripped = substr($str, 4,2)=~s/^\s+//;
say "*****$middle_substring_stripped*****"; …

<BlankoHomescreen>
        <Plugins BundleIdentifier="com.ChatClient" LockingStatus="none" TemplateIdentifier="0x2001f489" Uid="0x2000DBA7" extensionPolicy="replace" />
        <Plugins BundleIdentifier="com.movieteasers" LockingStatus="none" TemplateIdentifier="0x2001E1F9" Uid="0x2000FFBB" />
      </BlankoHomescreen>

These tags are in your variant.confml file in a different position in a slightly different format. I can't control where in the file the tags appear but that shouldn't matter. However you should be able to preserve the original format of those tags by adding them to the ForceArray parameter of the XMLin, as follows.

my $hashref = XMLin($conf,
                    ForceArray => [qw(Enabled
                                   BundleIdentifier
                                   TemplateIdentifier
                                   LockingStatus)],
                    KeyAttr => [],
                    NoAttr => 0,
                    KeepRoot => 1);

The following works for me

CREATE TABLE tasks(
TaskID INT AUTO_INCREMENT ,
TaskDueDate DATETIME,
Completed TEXT( 3 ) ,
PRIMARY KEY ( TaskID )
)

INSERT INTO `tasks` (
`TaskID` ,
`TaskDueDate` ,
`Completed`
)
VALUES (
NULL , NOW( ) , 'No'
);

SELECT count( TaskID ) AS DueToday
FROM tasks
WHERE DATE( TaskDueDate ) = CURRENT_DATE
AND Completed = 'No';

+----------+
| DueToday |
+----------+
|        1 | 
+----------+
1 row in set (0.00 sec)

Hi d5e5,

Great Thank you.. I was looking for same one i got my desired output.

Once again thanks for all your effort and suppport.

You're welcome. I'm glad it finally works.

Please don't forget to mark this thread solved.

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

my $filename_old = 'old.txt';
my $filename_new = 'new.txt';
my %data;
my %moved;

read_file($filename_old);
read_file($filename_new);

#Find lines moved from old
foreach my $v(keys %{$data{$filename_old}}){
    foreach my $g(keys %{$data{$filename_old}->{$v}}){
        $data{$filename_new}->{$v}->{$g}->{count} = 0
            unless defined $data{$filename_new}->{$v}->{$g}->{count};
        if ($data{$filename_old}->{$v}->{$g}->{count}
            > $data{$filename_new}->{$v}->{$g}->{count}) {
            $moved{'from'}->{$v}->{'value'} = $v;
            $moved{'from'}->{$v}->{'group'} = []
                unless defined $moved{'from'}->{$v}->{'group'};
            push @{$moved{'from'}->{$v}->{'group'}}, $g;
            #say "$v $g count is $data{$filename_old}->{$v}->{$g}->{count}";
            #say "$filename_new $v $g count is $data{$filename_new}->{$v}->{$g}->{count}";
        }
    }
}

#Find lines moved to new
foreach my $v(keys %{$data{$filename_new}}){
    foreach my $g(keys %{$data{$filename_new}->{$v}}){
        $data{$filename_old}->{$v}->{$g}->{count} = 0
            unless defined $data{$filename_old}->{$v}->{$g}->{count};
        if ($data{$filename_new}->{$v}->{$g}->{count}
            > $data{$filename_old}->{$v}->{$g}->{count}) {
            $moved{'to'}->{$v}->{'value'} = $v;
            $moved{'to'}->{$v}->{'group'} = []
                unless defined $moved{'to'}->{$v}->{'group'};
            push @{$moved{'to'}->{$v}->{'group'}}, $g;
            #say "$v $g count is $data{$filename_old}->{$v}->{$g}->{count}";
            #say "$filename_new $v $g count is $data{$filename_new}->{$v}->{$g}->{count}";
        }
    }
}

foreach my $k(sort keys %{$moved{'from'}}){
    my $v = $moved{'from'}->{$k}->{'value'};
    my @gf = @{$moved{'from'}->{$k}->{'group'}};
    my @gt = @{$moved{'to'}->{$k}->{'group'}};
    say "Value $v from group @gf has been moved to @gt group";
}

sub read_file {
    my $filename = shift;
    open my $fh, '<', $filename or die "Failed to open $filename: $!";    
    while (<$fh>){
        chomp;
        next if m/^##/; #Skip commented-out data lines
        next unless m/\d{3}/;
        my ($group, $value) = split;
        $data{$filename}->{$value}->{$group}->{'count'}++;
    }
}

This gives the following output:

Value 465 from group Unknown has been moved to DEF group
Value 876 from group ABC has been moved to Unknown group

I assumed that if a certain value was found this implies that it was moved. However i am not sure if OP wanted to check for values that moved from any group (which, if i'm not mistaken, is what my code does).
Since we have 2 code samples now i'm sure OP should be able to figure it out by himself now :)

I'm still not completely sure that any program can say what lines 'moved' from FileA to FileB and vice versa by reading only those two files without reading a previous version of them -- especially since @realoneomer had to show us the contents of the previous versions in order to explain what it meant for lines to 'move'.

If I needed to do something like this, I would first try to get by with using some procedure to compare FileA with FileB, such as the diff command in Linux or one of several examples available in Perl to find the difference between two text files, and see if that served the purpose. Trying to determine what lines moved from what file to what file might require reading the previous files and comparing with them as well, and that could require a lot of work.

The following does not give exactly the output you want but hopefully it is a first step in that direction.

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

my $filename_a = 'a.txt';
my $filename_b = 'b.txt';
my %data;

read_file($filename_a);
read_file($filename_b);

#use Data::Dumper;
#print Dumper(\%data);

foreach my $v(keys %{$data{$filename_a}}){
    foreach my $g(keys %{$data{$filename_a}->{$v}}){
        $data{$filename_b}->{$v}->{$g}->{count} = 0
            unless defined $data{$filename_b}->{$v}->{$g}->{count};
        if ($data{$filename_a}->{$v}->{$g}->{count}
            != $data{$filename_b}->{$v}->{$g}->{count}) {
            say "$filename_a $v $g count is $data{$filename_a}->{$v}->{$g}->{count}";
            say "$filename_b $v $g count is $data{$filename_b}->{$v}->{$g}->{count}";
        }
    }
}

sub read_file {
    my $filename = shift;
    open my $fh, '<', $filename or die "Failed to open $filename: $!";    
    while (<$fh>){
        chomp;
        next if m/^##/; #Skip commented-out data lines
        next unless m/\d{3}/;
        my ($group, $value) = split;
        $data{$filename}->{$value}->{$group}->{'count'}++;
    }
}

This gives the following output:

a.txt 431 ABC count is 1
b.txt 431 ABC count is 0
a.txt 431 Unknown count is 1
b.txt 431 Unknown count is 0

No working for me still. Unfortunately.

Still not working? What do you get in your status.txt file? After running this script that reads the fruit.txt and status.txt files containing the data that you posted, the status.txt file contains the following (on my computer, anyway):

<configuration name="variant" version="2.91.0" xmlns="http://www.fruits.com/xml/confml/2" xmlns:xi="http://www.w3.org/2001/XInclude" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:xs="http://www.w3.org/2001/XMLSchema">
    <data>
      <apple>
        <In_Stock>true</In_Stock>
      </apple>
      <banana>
        <In_Stock>true</In_Stock>
      </banana>
      <durian>
        <In_Stock>true</In_Stock>
      </durian>
      <grapes>
        <In_Stock>false</In_Stock>
      </grapes>
      <guava>
        <In_Stock>true</In_Stock>
      </guava>
      <jackfruit>
        <In_Stock>false</In_Stock>
      </jackfruit>
      <lychee>
        <In_Stock>true</In_Stock>
      </lychee>
      <melon>
        <In_Stock>true</In_Stock>
      </melon>
      <pineapple>
        <In_Stock>true</In_Stock>
      </pineapple>
      <rambutan>
        <In_Stock>true</In_Stock>
      </rambutan>
    </data>
  </configuration>

How does that not meet your requirement?

Hello Perl Guru's

I am playing with two text files using perl but i have been end up after a one day effort and got nothing there fore i have decided to post some thing here for help well here are some details that what actually i want to do

(I am genarating one file from shell script and on the end of execution this file will be renamed to file_old and after that a shell script will be executed on next day and it will generate a file with name file_new and then i want to compare both the files that is if a value of col2 has been changed then show me the value of col1 either from FileA or FileB)

I have two text files name FileA and FileB and both files have two columns like

FileA

Col1 Col2
ABC 123
ABC 987
DEF 456
DEF 898
DEF 658
GHI 789

and FileB also have two columns and it looks like

Col1 Col2
ABC 123
ABC 987
DEF 456
DEF 898
DEF 658
GHI 789
GHI 435
GHI 654
KLM 543
KLM 123
KLM 324

now i want to compare the col2 of both files against col1 if any data in col2 has moved in first or second file then show me the value in col1 from both files i.e., if data has moved from fileA to fileB then show …

I modified Mani's solution a little, mostly changing optional parameters for the XMLin and XMLout methods.

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

use XML::Simple;

my $fr = 'fruit.txt';
open (my $fh, '<', $fr) or die "Unable to open $fr: $!";
my @fruits = <$fh>;
close ($fh);
chomp(@fruits);

my $status = 'status.txt';

my $hashref = XMLin($status,
                    ForceArray => ['In_Stock'],
                    KeyAttr => [],
                    NoAttr => 0,
                    KeepRoot => 1);

my ($root_tag) = keys %$hashref;#Discover the name of that first tag you want to keep

### Status update in hash
foreach(@fruits){
	    $hashref->{$root_tag}->{'data'}->{$_}->{'In_Stock'} = ['true'];
}

### print the update value $status
print XMLout(
        $hashref,
             KeyAttr => [],
             NoAttr => 0,
             RootName => undef,
             OutputFile => $status,
       );

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

use XML::Simple;

my $fr = 'fruit.txt';
open (my $fh, '<', $fr) or die "Unable to open $fr: $!";
my @fruits = <$fh>;
chomp @fruits;

my $status = 'status.txt';

my $hashref = XMLin($status);

foreach(@fruits){
    $hashref->{$_}->{'In_Stock'} = 'true';
}

print "<data>\n";
foreach (keys %{$hashref}){
    print "\t<$_>\n\t\t<In_Stock>\n\t\t\t$hashref->{$_}->{'In_Stock'}\n\t\t</In_Stock>\n\t</$_>\n";
}
print "</data>\n";

This gives the following output:

<data>
	<grapes>
		<In_Stock>
			true
		</In_Stock>
	</grapes>
	<guava>
		<In_Stock>
			true
		</In_Stock>
	</guava>
	<rambutan>
		<In_Stock>
			true
		</In_Stock>
	</rambutan>
	<apple>
		<In_Stock>
			true
		</In_Stock>
	</apple>
	<orange>
		<In_Stock>
			true
		</In_Stock>
	</orange>
	<durian>
		<In_Stock>
			true
		</In_Stock>
	</durian>
	<banana>
		<In_Stock>
			false
		</In_Stock>
	</banana>
	<coconut>
		<In_Stock>
			true
		</In_Stock>
	</coconut>
	<palm>
		<In_Stock>
			true
		</In_Stock>
	</palm>
	<jackfruit>
		<In_Stock>
			false
		</In_Stock>
	</jackfruit>
	<lychee>
		<In_Stock>
			true
		</In_Stock>
	</lychee>
	<melon>
		<In_Stock>
			true
		</In_Stock>
	</melon>
</data>

Hi Guys,

Thanks for your reply before i go to the above mentioned issue i need help on one more issue.

I have a text fileA with two columns.

Column A Column B

ABC 09
ABC 56
DEF 98
DEF 87
DEF 89
DEf 55
GHI 67
GHI 56
JKL 98
MNO 90

Now i want to do is

read the first column from fileA and if the next line of columnA is similar with line-1 then add 1 in the counter and then display the result although i have to write to code but it is not working.
could you guys please help me out with this..?

Thanks in advance

In the future when you have a new question please start a new thread to ask it. That makes it easier for someone searching for the answer to a question similar to your new one. For now, you can try the following:

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

my $fh; #Declare a filehandle
if (-e 'a.txt'){
    open ($fh, '<', 'a.txt') or die "Can't open 'a.txt': $!";
}
else{
    #If a.txt doesn't exit in working dir, read data from DATA section
    #by aliasing the filehandle (convenient for testing)
    $fh = *DATA;
}

my %h; #Declare a hash to count column A values
while(<$fh>){
    next unless m/\d+/;#Skip lines containing no digits
    my ($col_a, $col_b) = split;
    $h{$col_a}++;#Count occurence of this value
}

foreach(sort keys %h){
    my $s = ($h{$_} == 1) …

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my $fa = 'a.txt';
my $fb = 'b.txt';

my %h; #Hash to store file 'a' data
# First, open and read file 'a' into a hash
open (my $fha, '<', $fa) or die "Unable to open $fa";

while (<$fha>){
    next unless m/\d+/; #Skip this line if it doesn't contain a number
    my @data = split;
    $h{$data[1]} = $data[0];
}
close $fha;
#print Dumper(\%h);

open (my $fhb, '<', $fb) or die "Unable to open $fb";
while (<$fhb>){
    chomp;
    next unless m/\d+/; #Skip this line if it doesn't contain a number
    next unless exists $h{$_}; #Skip this line if no hash key for this number
    print "$_ from file B => $h{$_} from file A\n";
}
close $fhb;

First you could create an SQLite database with one table into which you will insert all the data. (Later you may want to normalise the data by creating other tables and copying data into them from your first table.)

Then you could use a programming language such as perl or python to extract the data from the html and transform it into a series of INSERT statements which you can run in SQLite.

You could use the following query as an alternative to creating a table of months.

SELECT m.month, p.pay
FROM (
SELECT 'January' AS
MONTH
UNION SELECT 'February' AS
MONTH
UNION SELECT 'March' AS
MONTH
UNION SELECT 'April' AS
MONTH
UNION SELECT 'May' AS
MONTH
UNION SELECT 'June' AS
MONTH
UNION SELECT 'July' AS
MONTH
UNION SELECT 'August' AS
MONTH
UNION SELECT 'September' AS
MONTH
UNION SELECT 'October' AS
MONTH
UNION SELECT 'November' AS
MONTH
UNION SELECT 'December' AS
MONTH
) AS m
LEFT JOIN payroll p ON m.month = p.month

Please explain the difference between LEFT JOIN and LEFT OUTER JOIN in MySQL. To the best of my knowledge there isn't any.

I can't find a clear explanation to this in docs but this question was asked on StackOverflow and the accepted answer was that it makes no difference which you use.

At another site someone wrote the following: "MySql only supports the LEFT OUTER JOIN syntax so as to support ODBC compliance."

What is the value of $file_path when you pass it as an argument to mkpath? To find out, insert the following statement in your code immediately before the statement that calls mkpath. print "Here is the path name to pass to mkpath:\n$path_name\n";#For debugging only Also I recommend that you include the statements

use strict;
use warnings;

at the beginning of your script and then fix the warnings and error messages that result from the strict and warnings modules.

You're welcome. Technically, you might get away with

print join "\n", @{$q}; #Not recommended. I'm not sure why this works (for me).

but it's safer to use one of the object's methods instead of figuring out the internal structure of the object, which may vary depending on the version of the Thread::Queue module.

The pending method gives you the number of items in the queue, so you can peek at each of them in a loop.

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

use Thread::Queue;
my $q = new Thread::Queue;
$q->enqueue('item1', 'item2', 'item3');

my $count = $q->pending;
my @queued_items;
push @queued_items, $q->peek($_) foreach(0 .. $count-1);

print "Items currently in queue:\n";
print  join "\n", @queued_items;

Hi Manimuthu,

Thanks for your reply..But this logic even i have tried. I wanted to use one single grep command for both operations. Is there a way to do this?

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

my @file_list= qw(aaa ddd bbb/aaa ccc ddd kkk/ddd hhh);
my %exist=();
#To remove duplicate elements.
my @unique = grep { ! $exist { $_ }++ } @file_list;

#To remove elements with same filename.
#Please write your code here.
my %filenames;
my $firstpass = 1;
my @unique_files = grep {
                        if ($firstpass == 1){
                            foreach (@unique){
                                my @arr = split('/');
                                $filenames{$arr[-1]}++;
                            }
                            $firstpass = 0;
                        }
                        defined($filenames{$_}) && $filenames{$_} == 1
                    } @unique;

print "Unique filename(s):\n", join ', ', @unique_files;

I don't have any experience with Telnet and can't reproduce your 'Alarm Clock'. Have you tried adding a print statement to print the $telnet->errmsg() when there is one?

# Get any errors
my $error = $telnet->errmsg;
if ($telnet->errmsg) { # continue with telnet stuff, else ignore device
    print $telnet->errmsg();# Add this line to examine errmsg
}
else {
#
# ... etc.

When I run your script with that line added the output is unknown remote host: DeviceIP of course because I have no device to telnet into, but I don't get an 'Alarm Clock' error and the script exits after printing the error. I don't see a problem if you have the script in a loop that is sleeping 5 minutes and retrying. You could print or log the errors or just ignore them.

Looks OK except opening a file without testing whether the open succeeds can result in confusion if the file fails to open, because the program will continue without giving an error until it tries to read a record from the unopened file. For that reason we usually add an or die... or an || die... clause to the open statement. See "Simple Opens" in http://perldoc.perl.org/5.10.0/perlopentut.html

Hi

It would not let me edit my post above, did previously but not now for some reason (I am logged in).

heres the file - and thanks for spending the time to help.

Strange, one of my text editors (gedit) tells me the file is plain text and another (Komodo Edit) says it is UTF-16 Little Endian. Try replacing the statement that opens the file with the following:

#Change the following to your path and file name
my $filename = '/home/david/Programming/data/FROM_ISODRAW.txt';

############## READ FILE FROM ISODRAW ##################
open (ReadFILE, '<:encoding(UTF-16)', $filename) or die "couldn't open $filename: $!";

Please post the file "FROM_ISODRAW.txt" as an attachment. That should give us a file with the original encoding preserved so we can reproduce the problem. Click the "Manage Attachments" button to attach your text file.

k_manimuthu's answers should work fine. Here is a slightly different way to do the same thing.

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

my $input_file = 'blast.txt';

open my $fh, '<', $input_file or die "Cannot Open the $input_file : $!";

my $sequence;
while (<$fh>){
    chomp;
    $sequence .= $_ unless m/^>/;#Skip the line that starts with >
}

print $sequence, "\n";

if ($sequence =~ /^ATG.*TAT$/){
    print "The above sequence starts with ATG and ends with TAT, so it's a gene.";
}
else{
    print "The above sequence is not a gene.";
}
close $fh;

This gives the following output:

ATGGGCCTACATCCACSTAT
The above sequence starts with ATG and ends with TAT, so it's a gene.

push @matches, $1 while ($source=~ m{(PATTERN)}g);

Is this you want ?

That looks good. Alternatively, you can assign the result of a global match to an array directly, without a loop.

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

my $source = '1 door and only 1 and yet its sides are 2';
my $pattern = qr/\ba\w*\b/;

my @matches = $source =~ m/$pattern/g;

print "Matches are:\n", join "\n", @matches;

#Matches are:
#and
#and
#are

split splits a string according to a pattern that separates what we want to be elements in a list and returns a list, if used in list context. Since the default is to split words separated by one or more whitespace characters, I could have taken the defaults for the split arguments, so that it would split the contents of the string in $_ (the default variable) on the default pattern. Here is a slightly improved, commented version of the subroutine, in a little script I used to test it from the command line.

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

#The following works even when more than one space separates the words.
print format_spn_string('peas carrots     beets corn');

sub format_spn_string{
    $_ = shift; #Assign first (and only) subroutine argument to $_
    my @array = split; #Split string ($_ if unspecified) and assign list to @array
    my $out = join ', ', @array; #join elements of list. Separator is comma space
    return $out;
}

Please try the following oversimplified script for an example of how to format your spsns with commas.

#!/usr/bin/perl
use strict;
use warnings;
 
use CGI qw(:standard);

main();

sub main
{
####print "<<HEADER"; #Commented out. Causes "malformed header" error.

print header; #Let the CGI module print your header
print "<html><head>\n";   
print "<title>RED DRILL PAGE</title></head>\n";
print "<body>\n";
print "<h3>Red Drill Credit Exposure</h3>\n";
if (param('spns')){
    my $spns = param('spns');
    $spns = format_spn_string($spns);
    print "spns are: $spns";
}
else{
    show_form();#calling show_form subroutine
}
print"</body></html>\n";
}

sub show_form
{
        my $url = url;
        print qq{<form name="input" action=$url method="get">\n};
        print qq{<table align="center" border="1" bordercolor="black" cellpadding="2" cellspacing="0">\n};
		print qq{<tr>};
		print qq{<td align="right">Please enter your SPNs</td};
		print qq{</tr>\n};
		print qq{<td align="left"><input type"text" width="7" name="spns" value="">};
		print qq{<BR>Place each SPN seperated by a space</td>};
		print qq{</table><center><input type="submit" value="Submitted"></center></form>\n};
}

sub format_spn_string{
    my $in = shift;
    my $out = join ', ', split /\s/, $in;
    return $out;
}

SELECT *
FROM details
WHERE BRAND IN('bmw', 'audi')

Alternatively you can say WHERE BRAND = 'bmw' OR BRAND = 'audi'

What happened when you tested it? I can't test your script because I don't have all your modules and don't have your l2cgi.cfg file. Try to access your script on your web server, then open /var/log/apache2/error.log or whatever file your server uses to report errors and see what errors you find near the end of the log.

Where did you find Murex::Passwords? I don't see it on CPAN.

Don't require cgi-lib.pl. Somebody asked about cgi-lib.pl on Perl Monks in 2005 and were advised not to use it because it was old and obsolete.

Instead of perl -pi.int -e 's/\|/,/g;' fileName.ext try using double quotes instead of the single quotes. perl -pi.int -e "s/\|/,/g;" fileName.ext http://stackoverflow.com/questions/660624/why-doesnt-my-perl-one-liner-work-on-windows

Your example has only enough data for inserting one row.

#!/usr/bin/env python
#python 2
import re
import sqlite3

conn = sqlite3.connect('example')
c = conn.cursor()

mylist = []
with open("usage.log") as fp:
      for line in fp:
            match = re.match(r'(0\.0\.0|1\.6\.1|1\.8\.1)\(([0-9\.]+)', line)
            if not match: continue
            version, value = match.groups()
            mylist.append(value)

#Execute the cursor   
c.execute('INSERT INTO energielog (sernr, peak, kwh) VALUES (?, ?, ?)', mylist)

# Save (commit) the changes
conn.commit()

#Retrieve and display all rows from your table
c.execute('select * from energielog order by sernr')
for row in c:
    print row

# Close the cursor
c.close()

Running the above gives the following output:

(u'06026104', u'0.1501', u'02484.825')

Note: I don't specify a value for ROWID because I assume it will autoincrement.

When you talk about the names of your rows you confuse me. Do you mean you have a table named energielog having three columns named sernr, peak and kwh?

I agree, if the OP is willing to install Mason (not difficult) and has permission to modify the server configuration. I experimented a little with Mason almost a year ago. It was fun and easy to install on my local host but a lot of the free web hosts don't allow you to modify your Apache config (if I remember correctly.)

I didn't really get my feet wet with Mason so didn't feel qualified to answer whatever follow-up questions could arise from posting a Mason example.