d5e5 109 Master Poster

I don't know the source of the problem with your script and can't say if the problem resides in $_ because I don't see where any value is assigned to $_ or $delim. What I can do is try to fix my script so it won't reject blank input.

What I suspect happened when you tested my script: your file of regex patterns may have included a blank record (just an extra carriage-return/line-feed character would do it) which resulted in an element containing a string made up of whitespace characters or nothing at all being included in the array I use to build the $pattern. I can fix that by removing any zero-length elements from the array before building the pattern. Please try the following:

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

#You can open a file and read from it.
#Here I read from my <DATA> handle for convenience.
#The point is, you want your regex patterns stored
#in an array.
my @arr = <DATA>;
foreach (@arr){
    s/^\s+//;#Remove leading whitespace
    s/\s+$//;#Remove trailing whitespace
    $_ = quotemeta($_); #Escape characters such as $, ., etc,
}

@arr = grep(length($_) > 0, @arr); #Weed out all zero-length elements

my $pattern = '(' . join('|', @arr) . ')';

#Now let's say you read two input records from <STDIN> (not shown here)
#and assign them to $input1 and $input2
my $input1 = "GET / HTTP/1.0";
my $input2 = "Windows NT 5.2; en-US; rv:1.9.1.6; Major 3.0)";
my $input3 = "\t   \n"; #Input can be all …
d5e5 109 Master Poster

Since you want to use text from a file to construct a regex pattern, you need to remember to escape the characters in this text that would otherwise have special significance to regex. You can use the quotemeta() function to do this.

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

#You can open a file and read from it.
#Here I read from my <DATA> handle for convenience.
#The point is, you want your regex patterns stored
#in an array.
my @arr = <DATA>;
foreach (@arr){
    s/^\s+//;#Remove leading whitespace
    s/\s+$//;#Remove trailing whitespace
    $_ = quotemeta($_); #Escape characters such as $, ., etc,
}
my $pattern = '(' . join('|', @arr) . ')';

#Now let's say you read two input records from <STDIN> (not shown here)
#and assign them to $input1 and $input2
my $input1 = "GET / HTTP/1.0";
my $input2 = "Windows NT 5.2; en-US; rv:1.9.1.6; Major 3.0)";

#Testing $input1
if ($input1 =~ m/$pattern/){
    print "Reject$input1\n"; #Matches
}else{
    print "$input1\n"; #No match
}

#Testing $input2
if ($input2 =~ m/$pattern/){
    print "Reject$input2\n"; #Matches
}else{
    print "$input2\n"; #No match
}

__DATA__
Major
Minor
$Low
High
High /3.21 www.heal.com
$Major
d5e5 109 Master Poster

Hello,

I am learning perl programming but my problem is iam unable to find how the functions, commands,loops & conditions are working in a programme can anyone help me how to write a programme? what is the logic?

What is the logic? For example, here is a statement that contains a condition:

If we could write better tutorials than you can find already HERE and we had the time then we could answer your question.:)

Start writing and running short, simple programs first. If one of your programs doesn't work, post the shortest, simplest version of your code here, enclosed in [code] Your code goes here [/code] tags and tell us what output you expected to get, and what output you got instead. If we can reproduce the error simply we may be able to help.

d5e5 109 Master Poster

Yes, it replaces only the specified string in the specified column. Forward slashes in other columns won't change.

d5e5 109 Master Poster

For a table named 'items':

update items set itemName = replace(itemName,'/','');
d5e5 109 Master Poster

I've seen that done a lot querying an Oracle database where I used to work. It worked fine. I haven't tried that in MySQL but I can't think of any reason that it wouldn't work.

Just keep in mind that if you do this a lot you may end up with a lot of views depending on a lot of views. If you want to change or delete some of these views (as in "let's do a clean-up") you need to remember which views depend on the views you want to change. I remember we had a lot of old views cluttering our database that nobody wanted to delete in case some report, procedure or other view used them. We finally had to get our act together and remove the unused views.

d5e5 109 Master Poster

You want all the lines containing the literal 'STRING' plus only two of the lines containing the literal 'INTEGER'? Here is how you could match the lines you want using a regex pattern.

#!/usr/bin/env python
import re

#You didn't say what rule you had in mind
#when you chose only the last two lines containing 'INTEGER'
#so the following pattern represents my guess
pattern = r'(STRING:.+)|(5\.1537\.(2|3) = INTEGER: \d)$'

for line in open('/home/david/Programming/Python/data.txt'):
    match = re.search(pattern, line)
    if match:
        print line.rstrip()

This gives the following output.

.1.3.6.1.2.1.25.3.7.1.2.1537.1 = STRING: "/dev/hdb1"
.1.3.6.1.2.1.25.3.7.1.2.1537.2 = STRING: "/dev/hdb2"
.1.3.6.1.2.1.25.3.7.1.2.1537.3 = STRING: "/dev/hdb3"
.1.3.6.1.2.1.25.3.7.1.3.1537.1 = STRING: "0x341"
.1.3.6.1.2.1.25.3.7.1.3.1537.2 = STRING: "0x342"
.1.3.6.1.2.1.25.3.7.1.3.1537.3 = STRING: "0x343"
.1.3.6.1.2.1.25.3.7.1.5.1537.2 = INTEGER: 3
.1.3.6.1.2.1.25.3.7.1.5.1537.3 = INTEGER: 0
d5e5 109 Master Poster

How about attaching a sample file and telling us what part of the data you want to extract? That way those of us who are not network engineers might understand what you want to do. For example, does your file contain data like the following?

.1.3.6.1.2.1.25.3.7.1.1.1537.1 = INTEGER: 1
.1.3.6.1.2.1.25.3.7.1.1.1537.2 = INTEGER: 2
.1.3.6.1.2.1.25.3.7.1.1.1537.3 = INTEGER: 3
.1.3.6.1.2.1.25.3.7.1.2.1537.1 = STRING: "/dev/hdb1"
.1.3.6.1.2.1.25.3.7.1.2.1537.2 = STRING: "/dev/hdb2"
.1.3.6.1.2.1.25.3.7.1.2.1537.3 = STRING: "/dev/hdb3"
.1.3.6.1.2.1.25.3.7.1.3.1537.1 = STRING: "0x341"
.1.3.6.1.2.1.25.3.7.1.3.1537.2 = STRING: "0x342"
.1.3.6.1.2.1.25.3.7.1.3.1537.3 = STRING: "0x343"
.1.3.6.1.2.1.25.3.7.1.4.1537.1 = INTEGER: 14877060 KBytes
.1.3.6.1.2.1.25.3.7.1.4.1537.2 = INTEGER: 9920624 KBytes
.1.3.6.1.2.1.25.3.7.1.4.1537.3 = INTEGER: 0 KBytes
.1.3.6.1.2.1.25.3.7.1.5.1537.1 = INTEGER: 1
.1.3.6.1.2.1.25.3.7.1.5.1537.2 = INTEGER: 3
.1.3.6.1.2.1.25.3.7.1.5.1537.3 = INTEGER: 0

I copied that from http://www.unleashnetworks.com/resources/articles/95-work-with-output-from-snmpwalk.html but I don't know what portion of the file you want to extract.

d5e5 109 Master Poster

Yes, it works for me after making the change Mike suggested. It keeps the userName after I click on various letters.

Does it lose its value for you the first time you click a letter, or only after you click a specific sequence of letters?

You appear to have an elusive run-time bug that occurs only sporadically. I don't know how to fix it, but I do recommend you add use strict; near the start of your perl script. It will cause several error messages that you can fix by declaring your variables and not using bare words for letters. In the process of satisfying the requirements of the strict module you may solve your problem, or not. But your instructor would probably agree that you should use strict for any non-trivial program.

"You should use the strict pragma for any Perl script more than a few lines long, and for all CGI scripts."

d5e5 109 Master Poster

Try this. I didn't have much time for testing but it seems OK to me.

import re

def main():
    pattern = r'pow\((\w+),\(?(-?\w+)\)?\)'
    expr0 = 'p_neg1_1_n/pow(deltax,-4) - 4*p_0_1_n/pow(deltax,4)'    
    expr1 = 'p_neg1_1_n/pow(deltax,(-4)) - 4*p_0_1_n/pow(deltax,(4))'
    
    print re.sub(pattern , r'\1^\2', expr0)
    print re.sub(pattern , r'\1^\2', expr1)

if __name__ == "__main__":
    main()
nkinar commented: Wonderful; thank you so much +1
d5e5 109 Master Poster

I'm using Python to post-process the output of a program that creates strings of C code. The plot thickens, since the program can also create the following types of (more complicated) expressions:

expr0 = 'p_neg1_1_n/pow(deltax,-4) - 4*p_0_1_n/pow(deltax,4)'    
    expr1 = 'p_neg1_1_n/pow(deltax,(-4)) - 4*p_0_1_n/pow(deltax,(4))'

In these expressions, the number can be -4, or the number can occur in brackets (-4), or (4). I believe that this is valid C-code syntax.

Using regular expressions, is there a way to deal with expr0 and expr1 so that pow(deltax,(-4)) becomes deltax^-4 and pow(deltax,(4)) becomes deltax^4 ?

I don't know. It seems like a tough one. I think it may require applying a substitution to an expression and then applying another substitution to the resulting string? If I think of a solution later I'll let you know.

d5e5 109 Master Poster

One dot represents one character. Since now you want to match 'deltax', which contains several characters, you can add the plus sign to mean 'one or more characters'. But that matches too much. You want to match only 'deltex', not 'deltax,4) - 4*p_0_1_n/pow(deltax,4)'.

Let's use (\w+) instead of (.+). \w represents only alphanumeric characters, so it will stop matching at the comma, which is what you want.

import re

def main():

    expr = 'p_neg1_1_n/pow(deltax,4) - 4*p_0_1_n/pow(deltax,4)'
    print re.sub(r'pow\((\w+),(\w+)\)' , r'\1^\2', expr)

if __name__ == "__main__":
    main()
nkinar commented: Excellent response; again, thank you! +1
d5e5 109 Master Poster

Escape the open and close parentheses that are meant as literal characters and enclose the data that should be captured in parentheses to create two capture groups. These two capture groups are referenced in your replacement string as \1 and \2.

#!/usr/bin/env python
import re

def main():
    expr = '5*pow(a,b) + 3*pow(b,c) + 3*a + 4*b'
    print re.sub(r'pow\((.),(.)\)' , r'\1^\2', expr)

if __name__ == "__main__":
    main()
nkinar commented: Great solution; thank you very much +1
d5e5 109 Master Poster

I tested with the following old entries in 1.csv

user,Petergr," CN=Peter Graham,OU=Newport,DC=cp,dc=com"
user,Janiebo," CN=Janie Bourne,OU=Newport,DC=cp,dc=com"
user,Edgardu," CN=Edgar Dunn,OU=Newport,DC=cp,dc=com"
user,Belindaha," CN=Belinda Hart,OU=Newport,DC=cp,dc=com"
user,Mayja," CN=May Jamieson,OU=Newport,DC=cp,dc=com"
user,Leroyot," CN=Leroy Ota,OU=Newport,DC=cp,dc=com"

I modified the 4th line and added a 7th line to the above and saved it as 2.csv

user,Petergr," CN=Peter Graham,OU=Newport,DC=cp,dc=com"
user,Janiebo," CN=Janie Bourne,OU=Newport,DC=cp,dc=com"
user,Edgardu," CN=Edgar Dunn,OU=Newport,DC=cp,dc=com"
user,Belindajo," CN=Belinda Jones,OU=Newport,DC=cp,dc=com"
user,Mayja," CN=May Jamieson,OU=Newport,DC=cp,dc=com"
user,Leroyot," CN=Leroy Ota,OU=Newport,DC=cp,dc=com"
user,Rabbitbr," CN=Rabbit Brer,OU=Newport,DC=cp,dc=com"

The following program should print only the data for Belindajo and for Rabbitbr, because all the other lines in 2.csv exist in 1.csv and so are not new.

#!/usr/bin/perl
#find_new_records.pl
use strict;
use warnings;

my $dir = '/home/david/Programming/Perl/data';
my $f1 = "$dir/1.csv";
my $f2 = "$dir/2.csv";
open FILE1, "$f1" or die "Could not open $f1: $! \n";

my %results = ();#Hash to store lines from files
my %meaning = (-1, "In new file but not in old file",
               0, "In both new and old files",
               1, "In old file but not in new file",); #Hash associating values with statuses

while(my $line = <FILE1>){
    chomp $line;
    $results{$line}=1;
}
close(FILE1);

open FILE2, "$f2" or die "Could not open $f2: $! \n";
while(my $line =<FILE2>) {
    chomp $line;
    $results{$line}--; #Instead of incrementing by one...
}
close(FILE2);

foreach(keys %results){
    print "Key $_\n" if $results{$_} == -1;
}

The above gives me the following output:

Key user,Rabbitbr," CN=Rabbit Brer,OU=Newport,DC=cp,dc=com"
Key user,Belindajo," CN=Belinda Jones,OU=Newport,DC=cp,dc=com"
BastienP commented: Great stuff, as usual !!!! +1
d5e5 109 Master Poster

I don't understand the use of the # in your message. It indicates a comment in perl. If I were you I'd RTFM, of which David posted an important portion. If you do the regex as David suggested, you'll remove all non-letter/number/dash/underscore characters and you'll never have to run the error code. I think you either need to test for their existence and print the error or remove them, but not both.

Good point. my $teacher =~ s/[^A-Za-z0-9\-_]//g; removes all characters that are not letters, numbers, hyphen or underscore, but this is NOT what you say you want to do. You want to know if your regex matches any invalid characters; you don't want to substitute anything. The s prefix means 'substitute'. You want to match instead of substitute. There are plenty of examples of matching in http://perldoc.perl.org/perlrequick.html#Simple-word-matching and http://perldoc.perl.org/perlrequick.html#Using-character-classes

d5e5 109 Master Poster

Near the beginning of the documentation for Getopt::Long it says "To distinguish between a bundle of single-character options and a long one, two dashes are used to precede the option name." You would type the following at your command line to run your script.pl perl script.pl --teacher In every perl script that you write you should use strict; and use warnings; ... they sometimes tell you why your program may not do what you expect.

The following: #my $teacher =~ s/[^A-Za-z0-9\-_].//#//g; violates the syntax rules because the semicolon does not terminate the command. Putting a semicolon in a comment doesn't do anything.

Maybe you meant this instead? my $teacher =~ s/[^A-Za-z0-9\-_]//g;#Remove characters not in the good set But how can you remove characters from $teacher, which comes from Getopt::Long::GetOptions("teacher=s" => \$teacher); BEFORE the statement that gets the teacher option? The statements occur in the wrong sequence in your script.

Plus you put brace brackets around your condition instead of parentheses, and your print statement should be enclosed in brace brackets because you want it to be in a block following your unless condition.

d5e5 109 Master Poster

The trailing space in $lkup_cd1 spoils the test for '.LOC'. I changed only the following subroutine.

sub compareinstances
{
    my $x = shift @_;
    my $y = shift @_;
    my $modcodefrom1 = $instances_1[$x];
    my $modcodefrom2 = $instances_2[$y];
    my $inst_name1;
    if($modcodefrom1 =~ m/\)\s*\)\s*(.*)\s*\(\s*\./) {
        $inst_name1 = $1;
    }
    print "instance name of $modul from file1 $filename1 is $inst_name1\n";
   
    my $inst_name2;
        if($modcodefrom2 =~ m/\)\s*\)\s*(.*)\s*\(\s*\./) {
            $inst_name2 = $1;
        }
    print "instance name of $modul from file2 $filename2 is $inst_name1\n ";
   my @codes1 = split /\,/,  $modcodefrom1;
   my @codes2 = split /\,/,  $modcodefrom2;
   
    print "\t\t****************THE DIFFERENCES IN THE FILES ARE AS FOLLOWS****************\n\n\n";
   
    printf "\t\t%-45s \t\t\t%s\n\n\n", $filename1, $filename2;

    foreach (@codes1){
    if ( m/
        (         #capture following to $1
         (        #capture following to $2
         \.       #dot
         [^(]+    #one or more characters excepting (
        )         #end of capture group $2
         \s*      #possibly some spaces or newlines
         \(       #followed by open (
           [^)]*? #possibly some characters excepting )
           \)     #followed by close )
         )        #end of capture group $1
          /x ){   #end of match condition. x means ignore spaces and allow comments
        my $all_code_1 = $1;
        my $lkup_cd1 = $2;
        
        #The problem was $lkup_cd1 often has a trailing space
        #So in the following condition we must test if equal to '.LOC ' with trailing space
        next if ( $lkup_cd1 eq '.LOC' or $lkup_cd1 eq '.LOC '); #Skip to next iteration of loop
        
        #print "Look up $lkup_cd1\n"; #I print here for testing. May want to comment it out.
        
        my $code2compare = lookup_code2($lkup_cd1, \@codes2);
        
        unless ( $all_code_1 eq …
d5e5 109 Master Poster

I'm glad it works. I bought Beginning Perl by Simon Cozens 5 years ago and have read it all through. I have referred to it often. Now it is available for free online. Learning Perl, by Randal Schwartz and others is good too, but not free.

A good source of documentation and tutorials would be perl.org. When I'm stuck I google perl plus a few key words. Often the answer turns up on stackoverflow.com, perl.org, perlmonks.org, about.perl.com and of course, daniweb.com.

d5e5 109 Master Poster
#!/usr/bin/perl
use strict;
use warnings; 

my $filename1='/home/david/Programming/Perl/data/filename1.txt';
my $filename2='/home/david/Programming/Perl/data/filename2.txt';
my $modul='X_RAMD32';
print " --------------------------------File1: $filename1\t\t File2:$filename2    -------------------------------------\n\n"; 
print "Module selected for comparision $modul\n\n";
my $string1 = readfile( $filename1);
my $string2 = readfile( $filename2); 
$string1 =~ s/[[:cntrl:]]//gm; 
$string2 =~ s/[[:cntrl:]]//gm; 

$string1 =~ /($modul\s#\(.*\);)/gs;
my $instancesfrom1 = $1;
undef $string1;
my @instances_1 = $instancesfrom1 =~ /$modul #\(([^;]*)\);/g;
my $instancescount1 = @instances_1;
print "Found $instancescount1 instances of $modul in the $filename1\n";

$string2 =~ /($modul\s#\(.*\);)/gs;
my $instancesfrom2 = $1;
undef $string2;
my @instances_2 = $instancesfrom2 =~ /$modul #\(([^;]*)\);/g;
my $instancescount2 = @instances_2;
print "Found $instancescount2 instances of $modul in the $filename2\n";

#die "$filename1 doesn't have same number of instances of $modul as $filename2!"
 #   unless $instancescount1 == $instancescount2;
my $i=1;
my %instance_index_1 = buildindexhash(\@instances_1);
my %instance_index_2 = buildindexhash(\@instances_2);

foreach(sort keys %instance_index_1){
    if (exists $instance_index_2{$_}){
        print "Comparing $i Instance $_------\n";
        compareinstances($instance_index_1{$_}, $instance_index_2{$_});
    }
    else{
        print "Instance $_ not found in second file.------\n";
    }
$i++;
}

sub buildindexhash{
    my @arr = @{$_[0]}; 
    my %h;
    my $i;
    foreach (@arr){
        $_ =~ m/\)\s*\)\s*(.*)\s*\(\s*\./;
        $h{$1} = $i++;
    }
    return %h;
}

sub compareinstances
{
    my $x = shift @_;
    my $y = shift @_;
    my $modcodefrom1 = $instances_1[$x];
    my $modcodefrom2 = $instances_2[$y];
    my $inst_name1;
    if($modcodefrom1 =~ m/\)\s*\)\s*(.*)\s*\(\s*\./) {
        $inst_name1 = $1;
    }
    print "instance name of $modul from file1 $filename1 is $inst_name1\n";
   
    my $inst_name2;
        if($modcodefrom2 =~ m/\)\s*\)\s*(.*)\s*\(\s*\./) {
            $inst_name2 = $1;
        }
    print "instance name of $modul from file2 $filename2 is $inst_name1\n ";
   my @codes1 = split /\,/,  $modcodefrom1;
   my @codes2 = split /\,/,  $modcodefrom2;
   
    print "\t\t****************THE DIFFERENCES …
d5e5 109 Master Poster
#!/usr/bin/perl
use strict;
use warnings; 
my $filename1='/home/david/Programming/Perl/data/filename1.txt';
my $filename2='/home/david/Programming/Perl/data/filename2.txt';
my $modul='X_RAMB18E1';
print " --------------------------------File1: $filename1\t\t File2:$filename2    -------------------------------------\n\n"; 
print "Module selected for comparision $modul\n\n";
my $string1 = readfile( $filename1);
my $string2 = readfile( $filename2); 
$string1 =~ s/[[:cntrl:]]//gm; 
$string2 =~ s/[[:cntrl:]]//gm; 

$string1 =~ /($modul\s#\(.*\);)/gs;
my $instancesfrom1 = $1;
undef $string1;
my @instances_1 = $instancesfrom1 =~ /$modul #\(([^;]*)\);/g;
my $instancescount1 = @instances_1;
print "Found $instancescount1 instances of $modul in the $filename1\n";

$string2 =~ /($modul\s#\(.*\);)/gs;
my $instancesfrom2 = $1;
undef $string2;
my @instances_2 = $instancesfrom2 =~ /$modul #\(([^;]*)\);/g;
my $instancescount2 = @instances_2;
print "Found $instancescount2 instances of $modul in the $filename2\n";

die "$filename1 doesn't have same number of instances of $modul as $filename2!"
    unless $instancescount1 == $instancescount2;
my $i;

my %instance_index_1 = build_index_hash(\@instances_1);
my %instance_index_2 = build_index_hash(\@instances_2);

foreach(sort keys %instance_index_1){
    if (exists $instance_index_2{$_}){
        print "Comparing Instance $_------\n";
        compareinstances($instance_index_1{$_}, $instance_index_2{$_});
    }
    else{
        print "Instance $_ not found in second file.------\n"
    }
}

sub build_index_hash{
    my @arr = @{$_[0]}; #dereference passed parameter
    my %h;
    my $i;
    foreach (@arr){
        $_ =~ m/\)\s*\)\s*(.*)\s*\(\s*\./;
        $h{$1} = $i++;
    }
    return %h;
}

sub compareinstances
{
    my $x = shift @_;
    my $y = shift @_;
    my $modcodefrom1 = $instances_1[$x];
    my $modcodefrom2 = $instances_2[$y];
    my $inst_name1;
    if($modcodefrom1 =~ m/\)\s*\)\s*(.*)\s*\(\s*\./) {
        $inst_name1 = $1;
    }
    print "instance name from 1 is $inst_name1\n";
   
    my $inst_name2;
        if($modcodefrom2 =~ m/\)\s*\)\s*(.*)\s*\(\s*\./) {
            $inst_name2 = $1;
        }
    print "instance name from 2 is $inst_name2\n ";
   my @codes1 = split /\,/,  $modcodefrom1;
   my @codes2 = split /\,/,  $modcodefrom2;
   
    print "\t\t****************THE DIFFERENCES IN THE FILES ARE AS FOLLOWS****************\n\n\n"; …
d5e5 109 Master Poster

d5e5, thanks, in the meantime also for your reply!
so, is my for loop or your push-foreach solution quicker?

I don't know which runs quicker. My push foreach is quicker for me to understand, but maybe that's just a personal preference.

I haven't benchmarked it but I suspect a map statement would be the fastest to run, because perl already has the loop logic pre-defined in the map function.

map $data[$_] = 0, (0..$how_many_bins - 1); #This may run faster than foreach loop.
d5e5 109 Master Poster

Initialising the array in advance with a loop doesn't seem like a bad approach, either. It takes only about one line.

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

my @data = (); #Empty array with no elements
my $how_many_bins = 25; #Arbitrary example

#The following loop pushes a zero into the array for each element of a range.
#Remember array indexing starts at 0 so greatest index = $how_many_bins - 1
push @data, 0 foreach (0..$how_many_bins - 1);

print join ', ', @data;
d5e5 109 Master Poster

I think that for this we don't need to extract the separate instances and split the codes. We can apply the regex to the string from the file instead. This time we don't remove the newlines.

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

#Prepare regex pattern as follows (better to prepare complex rexex in advance)
my $pattern = '\\\U_eth_aggregator_tb/eth_aggregator/core_0/.+\(';
my $re = qr/$pattern/m;

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

my $modul='X_RAMB18E1';
my $string1 = readfile( $filename1);

my $count = 0;
my @matches = $string1 =~ m/$re/g;
foreach (@matches){
        $count++;
        print "Occurence number $count of the pattern:\n$_\n\n";
}

sub readfile {
    my $file = shift;
    local $/;
    open my $fh,'<',"$file" or die "open of $file failed: $!\n";
    <$fh>;
};

Running the above on the filename1.txt that you attached gives the following output:

Occurence number 1 of the pattern:
\U_eth_aggregator_tb/eth_aggregator/core_0/client_side_FIFO0/tx_fifo_i/ramgen_l  (

Occurence number 2 of the pattern:
\U_eth_aggregator_tb/eth_aggregator/core_0/client_side_FIFO0/tx_fifo_i/ramgen_u  (
d5e5 109 Master Poster

Check if executing:

SET names utf8

after connecting to the database will fix the problem.

Yes. Apparently this is an MySQL bug, according to this link: http://bugs.mysql.com/bug.php?id=10812

d5e5 109 Master Poster
#!/usr/bin/perl
use strict;
use warnings;

my $filename1='/home/david/Programming/Perl/data/filename1.txt';
my $filename2='/home/david/Programming/Perl/data/filename2.txt';

my $modul='X_RAMB18E1';
my $string1 = readfile( $filename1);
my $string2 = readfile( $filename2); 
$string1 =~ s/[[:cntrl:]]//gm; #Might as well get rid of newlines, etc. now
$string2 =~ s/[[:cntrl:]]//gm; #Might as well get rid of newlines, etc. now

#Extract instances of module from first file
$string1 =~ /($modul\s#\(.*\);)/gs;
my $string_of_instances_from_1 = $1;
undef $string1;
my @instances_1 = $string_of_instances_from_1 =~ /$modul #\(([^;]*)\);/g;
my $count_of_instances_1 = @instances_1;
print "Found $count_of_instances_1 instances of $modul in the string.\n";

#Extract instances of module from first file
$string2 =~ /($modul\s#\(.*\);)/gs;
my $string_of_instances_from_2 = $1;
undef $string2;
my @instances_2 = $string_of_instances_from_2 =~ /$modul #\(([^;]*)\);/g;
my $count_of_instances_2 = @instances_2;
print "Found $count_of_instances_2 instances of $modul in the string.\n";


die "$filename1 doesn't have same number of instances of $modul as $filename2!"
    unless $count_of_instances_1 == $count_of_instances_2;

my $i;
foreach(0..$#instances_1){
    $i = $_ + 1;
    print "Comparing Instance $i:-----------------------------------\n";
    compare_instances($_);
}

sub compare_instances{
    my $idx = shift @_; #Assign passed parameter to index variable
    my $modcode_from_1 = $instances_1[$idx];
    my $modcode_from_2 = $instances_2[$idx];
    my @codes1 = split /\,/,  $modcode_from_1;
    my @codes2 = split /\,/,  $modcode_from_2;
    print "\t\t****************THE DIFFERENCES IN THE FILES ARE AS FOLLOWS****************\n\n\n";
    printf "\t\t\t%-45s %s\n\n\n", $filename1, $filename2;
    my $i = 0;
    foreach ( @codes1) {
        unless ( $codes1[$i] eq $codes2[$i]) {
        printf "\t%-45s is not the same as %s\n\n", $codes1[$i], $codes2[$i];
        }
    $i++;
    }
}

sub readfile {
    my $file = shift;
    local $/;
    open my $fh,'<',"$file" or die "open of $file failed: $!\n";
    <$fh>;
};
d5e5 109 Master Poster

For the purpose of giving a simple example of extracting more than one instance from a string, I hard-coded a sample string instead of reading from your files. Notice that you can store the instances in an array instead of a single scalar variable.

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

my $string_of_instances = <<END;
SIMPLE_MODULE #(
aa
bb
cc
dd
);

SIMPLE_MODULE #(
aa
bx
cx
dd
);

END

my @instances = $string_of_instances =~ /SIMPLE_MODULE #\(([^;]*)\);/gs;
my $count_of_instances = @instances;
print "Found $count_of_instances instances of SIMPLE_MODULE in the string.\n";

foreach (@instances){
    do_something($_);
}

sub do_something{
    #This subroutine is just a stub.
    #You can add logic to do what you want for each instance.
    my $mod_instance = shift(@_); #Assign passed parameter
    print "The following is one of the instances:\n$mod_instance\n";
    print '-' x 70, "\n";
}

Running the above prints the following output:

Found 2 instances of SIMPLE_MODULE in the string.
The following is one of the instances:

aa
bb
cc
dd

----------------------------------------------------------------------
The following is one of the instances:

aa
bx
cx
dd

----------------------------------------------------------------------
d5e5 109 Master Poster

Try the following. I made a couple of changes to your script, indicated by comments. I changed the regex slightly because $f=~s/<!--[^>]*-->//g; will not remove comments if the character '>' occurs anywhere between the comment tags. It's better to use a dot that represents all characters.

#!/usr/bin/perl
use strict;
use warnings;
use File::Find;

#undef($/); Better to take care of $/ in subr as local variable

my $directory = "/home/user/perltest";
find (\&subr, $directory);

sub subr
{
    foreach ($File::Find::name=~/.*\.xsd$/) {
        open (FILE, "<", $File::Find::name);
        local $/;
        my $f=<FILE>;
        print $f;
        $f=~s/<!--.*-->//gs; #s option means dot (.) includes newline character
        close FILE;
        open (OUT, ">", $File::Find::name);
        print OUT $f;
        close OUT;
    }
}
d5e5 109 Master Poster
<?php

$full = '%B1500000000000015^EMPLOYEEID/SMITH John^031110100000019301000000877000000?;500000000000015=0305101193010877?';
$chunks = explode('?', $full);
echo $chunks[0] . '?';

?>

It looks like you want the value of $StringVar2 to equal that of $StringVar1. Is that correct?

d5e5 109 Master Poster
<?php
require('includes/init_mysql.php');
$con = mysql_connect($db_host,$db_user,$db_pass);
if (!$con)
  {
  die('Could not connect: ' . mysql_error());
  }

mysql_select_db("daniweb", $con);

$sql = "SELECT SUM(ct) FROM `test2`";

$result = mysql_query($sql) or die(mysql_error());

while($row = mysql_fetch_array($result)){
	echo "Total ". $row['SUM(ct)'];
}

mysql_close($con);
?>

This displays Total 6 on my browser. My code is the same as yours except for the name of the column ('ct' instead of 'Profit') and table ('test2' instead of 'table'). Are you sure your table really has a column named 'Profit' and does it have data? Is your table really named 'table'. I don't know if naming your table 'table' is causing a problem but in principle it's not good practice to name a table after an SQL reserved word such as 'table'.

d5e5 109 Master Poster

I haven't tested it but I think that either using DISTINCT or GROUP BY should eliminate the duplicate rows from your results. Try

SELECT DISTINCT clients.ClientID, clients.ClientUserID, clients.AddedByUserID, users.UserID, users.FullName, users.AccessLevel
FROM users LEFT JOIN clients on users.UserID = clients.ClientUserID
WHERE users.AccessLevel = 1  or (clients.ClientUserID = users.UserID)and clients.ClientID = ParamClientID

or else maybe

SELECT clients.ClientID, clients.ClientUserID, clients.AddedByUserID, users.UserID, users.FullName, users.AccessLevel
FROM users LEFT JOIN clients on users.UserID = clients.ClientUserID
WHERE users.AccessLevel = 1  or (clients.ClientUserID = users.UserID)and clients.ClientID = ParamClientID
GROUP BY clients.ClientID, clients.ClientUserID, clients.AddedByUserID, users.UserID, users.FullName, users.AccessLevel
d5e5 109 Master Poster
#!/usr/bin/perl
use strict;
use warnings;
my %years; #Hash to save year as key, count as value
while (<DATA>){
    chomp;
    $years{$_}++;
}
printf "%-10s %s\n",'year', 'count';
foreach (sort keys %years){
    printf "%-10s %d\n",$_, $years{$_};
}
__DATA__
1913
1913
1917
1917
1917
1917
1917
1955
1955
d5e5 109 Master Poster

You are welcome. Please mark the thread solved. It helps keep our forum organised. :)

d5e5 109 Master Poster
#!/usr/bin/perl
#compare_files.pl
use strict;
use warnings;
my $dir = '/home/david/Programming/Perl/data';
my $filename1 = '1.txt';
my $filename2 = '2.txt';

sub slurp_file {
    #This subroutine takes the path and filename of an input file
    # and returns a filehandle referencing the entire contents.
    my ($dir,$file) = @_;
    local $/;
    open my $fh,'<',"$dir/$file" or die "open of $dir/$file failed: $!\n";
    <$fh>;
    };

my $string1 = slurp_file($dir, $filename1); # $string1 now contains contents of 1.txt

my $string2 = slurp_file($dir, $filename2); # $string2 now contains contents of 2.txt

$string1 =~ /i_MMCM_ADV \(([^;]*)\);/s;
my $modcode_from_1 = $1;
undef $string1; #Don't need $string1 any more.
$modcode_from_1 =~ s/[[:cntrl:]]//gm; #Remove control characters

$string2 =~ /i_MMCM_ADV \(([^;]*)\);/s;
my $modcode_from_2 = $1;
undef $string2; #Don't need $string2 any more.
$modcode_from_2 =~ s/[[:cntrl:]]//gm; #Remove control characters

my @codes1 = split /\./, $modcode_from_1;
my @codes2 = split /\./, $modcode_from_2;

printf "%-35s %s\n", $filename1, $filename2;
my $i = 0;
foreach (@codes1) {
    unless ($codes1[$i] eq $codes2[$i]) {
        printf "%-35s is not the same as %s\n", $codes1[$i], $codes2[$i];
    }
    $i++;
}

Running this prints the following output:

1.txt                               2.txt
CLKIN1(clk_IBUF_7819),              is not the same as CLKIN1(clk_IBUF_2571),    
CLKOUT0(clk_out0_OBUF_7848),        is not the same as CLKOUT0(clk_out0_OBUF_2333),    
LOCKED(i_MMCM_ADV_ML_NEW_I1),       is not the same as LOCKED(LOCKED_OBUF_2386),
koduruabhinav commented: excellent answer +1
d5e5 109 Master Poster

The first part, storing the contents of the files into string variables and then extracting the module code from each into two string variables:

#!/usr/bin/perl
#extract_mods_to_strings.pl
use strict;
use warnings;
my $dir = '/home/david/Programming/Perl/data';
my $filename1 = '1.txt';
my $filename2 = '2.txt';

#The following way of 'slurping' files into strings adapted from
# http://www.perlmonks.org/?node_id=287647

my $string1 = do {
    local $/;
    open my $handle1,'<',"$dir/$filename1" or die "open of $dir/$filename1 failed: $!\n";
    <$handle1>;
    }; # $string1 now contains contents of 1.txt

my $string2 = do {
    local $/;
    open my $handle2,'<',"$dir/$filename2" or die "open of $dir/$filename2 failed: $!\n";
    <$handle2>;
    }; # $string2 now contains contents of 2.txt

$string1 =~ /i_MMCM_ADV \((.*)\);/s;
my $modcode_from_1 = $1;

$string2 =~ /i_MMCM_ADV \((.*)\);/s;
my $modcode_from_2 = $1;

print "Here is the module code from $filename1---------------------:\n";
print $modcode_from_1;
print "\n\n";
print "Here is the module code from $filename2---------------------:\n";
print $modcode_from_2;

I don't know how the comparison should be done and what constitutes a unit of code to compare and print.

d5e5 109 Master Poster

I think tesu may have solved this. However I find the query hard to test without your data, so if you still have a problem with it I would consider putting the CASE logic into a function. Then we can easily test the function without having your data and you can incorporate the function into your query, making it more readable and easier to debug.

You can create a function called determine_shift as follows (change the DEFINER to the appropriate user)

DROP FUNCTION `determine_shift`//
CREATE DEFINER=`root`@`localhost` FUNCTION `determine_shift`(ts TIMESTAMP) RETURNS varchar(5) CHARSET latin1
BEGIN
    IF ISNULL(ts) THEN RETURN NULL; END IF;
    
 CASE
     WHEN (TIME(ts) between '07:20:00' and '15:19:59') THEN RETURN 'day';
     WHEN (TIME(ts) between '15:20:00' and '23:19:59') THEN RETURN 'swing';
     WHEN (TIME(ts) BETWEEN '23:20:00' AND '23:59:59') OR (TIME(NOW()) BETWEEN '00:00:00' AND '07:19:59') THEN RETURN 'night';
     ELSE RETURN 'ERROR';
 END CASE;
END

Now we can test it as follows:

mysql> select determine_shift('2010-08-25 07:54:36') as should_be_day;
+---------------+
| should_be_day |
+---------------+
| day           | 
+---------------+
1 row in set (0.00 sec)

mysql> select determine_shift('2010-08-25 16:54:36') as should_be_swing;
+-----------------+
| should_be_swing |
+-----------------+
| swing           | 
+-----------------+
1 row in set (0.00 sec)

mysql> select determine_shift('2010-08-25 23:54:36') as should_be_night;
+-----------------+
| should_be_night |
+-----------------+
| night           | 
+-----------------+
1 row in set (0.00 sec)

Seems to work OK.

Now you can use it in your query as follows:

select day(timestamp) as tamp, tech, packer_l, packer_r,  (packed_l + packed_r) as packed, timestamp as ts
  FROM abm_status
  where
    determine_shift(timestamp) = …
d5e5 109 Master Poster

When you say you can't INSERT data in your parent table, could you show us an example of the code you are using to attempt that and quote the error message, if any, that results when you run it?

d5e5 109 Master Poster

I think the problem is that your CASE statement is evaluating to the number 1 instead of the string that you want for completing your WHERE condition. Look at this example:

mysql> select '07:20:00' AND '15:19:59' as shift;
+-------+
| shift |
+-------+
|     1 | 
+-------+

See? The result is 1 instead of '07:20:00' AND '15:19:59'. Put double quotes around the result to get a string:

mysql> select "'07:20:00' AND '15:19:59'" as shift;
+---------------------------+
| shift                     |
+---------------------------+
| '07:20:00' AND '15:19:59' | 
+---------------------------+
d5e5 109 Master Poster

good day! im an IT student. im new to php&mysql. my database engine is first myisam. everything works fine. but when i changed it into innodb(for foreign key purposes) i can't insert a data in my the parent table. i can insert data in child table though. replies are really appreciated! help me pls.!

I believe that which database engine a table uses is determined for each table, not for the entire database. When you create a table without specifying the database engine the table uses myisam by default. Are you sure you changed both your parent and your child table to innodb (you say you changed "it" rather than "them")?

It may help if you post a description of the tables here. For example, from the MySQL command line (not in PHP):

mysql> SHOW CREATE TABLE people;
+--------+------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| Table  | Create Table                                                                                                                                                                                               |
+--------+------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
| people | CREATE TABLE `people` (
  `id` int(11) NOT NULL AUTO_INCREMENT,
  `name` varchar(25) DEFAULT NULL,
  `dob` date DEFAULT NULL,
  PRIMARY KEY (`id`)
) ENGINE=MyISAM AUTO_INCREMENT=5 DEFAULT CHARSET=latin1 | 
+--------+------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
1 row in set (0.00 sec)
d5e5 109 Master Poster

Thanks for the link Mike. One of my favourites is $. although I haven't managed to use it much yet. $. Is not a regex variable but here is an example of using it to identify the line numbers where a regex match succeeds.

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

while (<DATA>){
    if (m/\bcane\b/){
        #The following statement uses the special variable $.
        #which contains the current line number of the input file
        print "Line number $. of the file contains the word $&.\n";
    }
}

__DATA__
The Spring blew trumpets of color;
Her Green sang in my brain --
I heard a blind man groping
"Tap -- tap" with his cane;

I pitied him in his blindness;
But can I boast, "I see"?
Perhaps there walks a spirit
Close by, who pities me, --

A spirit who hears me tapping
The five-sensed cane of mind
Amid such unguessed glories --
That I am worse than blind.

This prints the following:

Line number 4 of the file contains the word cane.
Line number 12 of the file contains the word cane.
d5e5 109 Master Poster
#!/usr/bin/perl
use strict;
use warnings;

#I'm reading my __DATA__ section but you can open your file
# instead and slurp it as follows: (I don't read a list of duplicates, only the first file)
undef $/;
my $whole_file = <DATA>; # 'slurp' mode
$/ = "\n"; #Put it back the way it was

#regular expression substitute in multi-line and global mode
$whole_file =~ s/^(\w+)([^\n]+\n)(?=\1)/$1.1$2/mg;
print $whole_file;

__DATA__
ID Entry Entry
1 0 0
2 1 0
2 0 1
3 1 1
4 0 0
4 0 0

This gives the following output:

ID Entry Entry
1 0 0
2.1 1 0
2 0 1
3 1 1
4.1 0 0
4 0 0
mitchems commented: David - that's just an awesome regex! +2
d5e5 109 Master Poster

I used my @port = qw(80 70 1083 42); to build myself an array for testing. qw() puts quotes around the space-delimited items you give it as arguments. The array you build by pushing values into it should work just as well.

As for how to retrieve the keys from the hash after it has been built I had a difficult time with that so may not have found the best way. But, how about the following? I couldn't get it to work at all until I changed your my $referenceTable to my %referenceTable and then slavishly followed one of examples at http://perldoc.perl.org/perldsc.html#HASHES-OF-HASHES.

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

my @port = qw(80 70 1083 42);
my ( $key1, $key2 ) = ( 'First Key', 'Second Key' );
my %referenceTable; #Declare a hash, not a reference.

foreach (@port) {
    undef $referenceTable{$key1}{$key2}{$_};
}

foreach my $x ( keys %referenceTable ) {
    print "Hash key is $x and ";
    for my $y ( keys %{ $referenceTable{$x} } ) {
        print "$y \n";
        print "Keys for hash stored in this hash are:\n";
        for my $z ( keys %{ $referenceTable{$x}{$y} }){
            print "$z\n";
        }
    }
}

This gives the following output:

Hash key is First Key and Second Key 
Keys for hash stored in this hash are:
42
70
1083
80
d5e5 109 Master Poster

I don't know how to print what you want yet but to figure it out I might start by using Data::Dumper to print the data structure and values.

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

my $referenceTable;
my @port = qw(80 70 1083 42);
my ( $key1, $key2 ) = ( 'First Key', 'Second Key' );

foreach (@port) {
    undef $referenceTable->{$key1}->{$key2}->{$_};
}

print Dumper($referenceTable);

Prints the following:

$VAR1 = {
          'First Key' => {
                           'Second Key' => {
                                             '42' => undef,
                                             '70' => undef,
                                             '1083' => undef,
                                             '80' => undef
                                           }
                         }
        };
d5e5 109 Master Poster

Yes, you need to have write permission for the file you want to delete, and according to a poster at the following link: "The folder that contains the file must ALSO have write permission."

d5e5 109 Master Poster
<?php
function string_of_xes($matches)
{
  // as usual: $matches[0] is the complete match
  $r = str_repeat('x', strlen($matches[0]));
  return $r;
}

$pattern = '/0{5,}/';
$string = '11000001100010011000001';
//Replace all strings of 0's with length 5 or longer with same # of x's
$temp1 = preg_replace_callback($pattern, string_of_xes, $string);
echo $temp1 . "\n";

//Replace all remaining 0's with 1's
$pattern = '/0/';
$temp2 = preg_replace($pattern, '1', $temp1);
echo $temp2 . "\n";

//Restore the x's back to 0's
$pattern = '/x/';
$string_out = preg_replace($pattern, '0', $temp2);
echo $string_out;
?>

Output is

11xxxxx1100010011xxxxx1
11xxxxx1111111111xxxxx1
11000001111111111000001
d5e5 109 Master Poster

Hi,

I've modified the code like this : if the option value is less than 100 add a zero in front it. eg: if $opt1 is 23 it should become 023.

i execute my script like this (without including the opt3) : my_script -opt1 80 -opt2 23

foreach my $val (@opt)
   { 
      if (defined $val and $$val < 100 and $$val != 0)
      { 
         $$val = sprintf("0%d",$$val); 
      }
      print "Check : $$val\n"; 
   }

The code works fine. But it gives some warnings (i have used all the headers that you have used).

Use of uninitialized value in numeric lt (<) at ./fun line 417.
Use of uninitialized value in numeric ne (!=) at ./fun line 417.

Can u clarify this.

Now you are only giving two options, but are you still defining three options, like this?
#our @opt = ( \$opt1, \$opt2, \$opt3 ); #Defining THREE options

If so, when you loop through the @opt array, you will get a warning because you are trying to compare and concatenate \$opt3 which receives nothing from the command line parameters.

Apparently, $val is always defined in your loop, so your test doesn't stop the warning. It is $$val which is not defined because \$opt3 sometimes has no value. The following runs OK for me:

#!/usr/bin/perl
#getopt04.pl
use strict;
use warnings;

use Getopt::Long;
#our ($opt1, $opt2, $opt3); 
#our @opt = ( \$opt1, \$opt2, \$opt3 ); #Defining THREE options
our ($opt1, $opt2); 
our @opt = ( …
d5e5 109 Master Poster
#!/usr/bin/perl
#getopt03.pl
use strict;
use warnings;

use Getopt::Long;
our ($opt1, $opt2, $opt3);
our @opt = ( \$opt1, \$opt2, \$opt3 );
GetOptions(
    'opt1=i' => \$opt1,
    'opt2=i' => \$opt2,
    'opt3=i' => \$opt3
);

check();
## I don't see a problem. The actual options do reflect the changes.
print "The actual values of the options are:\n"
        . "opt1 = $opt1\n"
        . "opt2 = $opt2\n"
        . "opt3 = $opt3\n";
        
sub check {
    foreach (@opt) {
        if ( $$_ < 100 ) {
            $$_ = 100;
        }
    }
}

Running the above script on the command line gives the following output:

perl getopt03.pl --opt1=150 --opt2=24 --opt3=32
The actual values of the options are:
opt1 = 150
opt2 = 100
opt3 = 100
d5e5 109 Master Poster
<?php
$ct = array (
             "a" => 1,
             "b" => 2,
             "z" => 2,
             "c" => 1
            );

$con = mysql_connect('localhost','david','mypwd');
if (!$con)
  {
  die('Could not connect: ' . mysql_error());
  }

mysql_select_db("daniweb", $con);

foreach($ct as $item => $count){
    $sql = "INSERT INTO test2(item,ct) VALUES ('$item', $count)";
    if ($result = mysql_query($sql)) {
        echo "One row inserted for $item\n";
    }
    else {
        echo "Failed to insert $item\n";
    }
}

mysql_close($con);
?>
d5e5 109 Master Poster

opendir(FOLD, @fld); First error I see is that opendir expects an expression naming one directory. Any variable starting with @ contains an array whereas opendir needs a string representing the name of one directory only.

d5e5 109 Master Poster

That's great. I didn't think of that (Getopt:Long version.) Please mark this thread solved (even though it was you that solved it. :))

d5e5 109 Master Poster

I'm not sure I understand doubts number 1 and 2. You say that GetOptions ('d:s{,}' => \@dir, 'f:s{,}' => \@fil); doesn't compile? The following works for me.

#!/usr/bin/perl
#getopt01.pl
use strict;
use warnings;

use Getopt::Long;
my (@dir, @fil);

#-- prints usage if there is an unknown parameter

usage() if ( ! GetOptions('d:s{,}' => \@dir, 'f:s{,}' => \@fil));
            
if (@dir > 0){
    print "\n-d option specified with the following values:\n"
        . join("\n", @dir), "\n\n";
}

if (@dir > 0){
    print "-f option specified with the following values:\n"
        . join("\n", @fil), "\n\n";
}

print "My perl version is: $]\n";
sub usage
{
  print "Unknown option: @_\n" if ( @_ );
  print "usage: program [-d DIRECTORY_NAME [DIRECTORY_NAME]...] [-f FILE_NAME [FILE_NAME]...]\n";
  exit;
}

Running the above on the command line:

$ perl getopt02.pl -d /home /etc -f note.txt appointments.txt list.com

-d option specified with the following values:
/home
/etc

-f option specified with the following values:
note.txt
appointments.txt
list.com

My perl version is: 5.010000