If there is anything in particular that you don't like about the code, tell us so.

And tell us what you tried, and why you are not satisfied with it.

My untrained eye can't spot any particular code smells. Though I have learned to use fetchrow_hashref, because it means you don't have to care about the order of the returned data, you just use the field names, but it does force you to learn about references. The code you have is already pretty concise and would only need a little more formatting to be more readable.

Also note that if you don't need the code you commented out, get rid of it or it will accumulate. I know it's something I have to fix in my own code. The odd #print ... is OK, but if you have version control you don't need big blocks of code commented out 'just in case you need to uncomment it one day'

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

# Establish connections to your respective databases
my $email_dbh;
my $email_sth;
my $names_dbh;
my $names_sth;

open(my $fh, '>', 'bad.email') or die "Unable to open 'bad.email' for 
+writing: $!";

while (my ($email) = $email_sth->fetchrow_array()) {
    my @names = guess_names($email);
    if (! @names) {
        print $fh $email, "NONE FOUND\n";
        next;
    }
    my $found;
    for my $name (@names) {
        my ($gender) = $names_sth->execute($name);
        if (defined $gender) {
            print join "\t", $email, $name, $gender;
            print "\n";
            $found = 1;
            last;
        }
    }
    if (! $found) {
        print $fh $email, (join ", ", @names), "\n";
    }
}

# After each run, check 'bad.email' to see if you can refine your patt
+erns

sub guess_names {
    my ($email) = @_;
    my @guess;

    # Strip domain from email address
    $email =~ s///;

    # See if it might be first.last, first_last, first-last
    if ($email =~ //) {
        push @guess, $1, $2;
    }

    # See if it might be first name followed by last initial
    push @guess, substr($email, 0, length($email) - 1);

    # Add more patterns here
    return @guess;
}
[download]

Yeah, like everybody else here. But what are exactly your problems? I suggest compiling a training/test set and then thinking why your algorithm does not classify some addresses correctly. If you then have a real question, ask the question here and don't forget to post the relevant data.

#!/usr/bin/perl

use DBI;

my $dbh = DBI->connect("DBI:mysql:database=email_categorisation;host=l
+ocalhost;", "root", "", {'RaiseError' => 1});
use Text::GenderFromName;

$query = "select email  from emails_1";
$sth = $dbh->prepare($query);
$email_record = $sth->execute();
$count =0;

     while(($email) = $sth->fetchrow_array())
       {
        #print "--$email--";
        $email =~/(.*\.*.*)\@(.+)/;
        my $user = $1;
        #print $user."  --  ";
        $user=~s/[0-9|\_|\.]//g;
        #print $user."  --  ";
        #matching
        $l = length($user);
        #print $l."\n\n";
        $flag=1;
        for ($i=0;$i<$l;$i++){
                if($flag==1){
                my $removed_last_letter = substr( $user, $i);
                #print $removed_last_letter."\n";
                $l2 = length($removed_last_letter);
                for ($j=0;$j<$l2;$j++){
                         my $removed_first_letter = substr ($removed_l
+ast_letter, 0,$l2-$j);    # returns '' (no warning)
                  #       print $removed_first_letter."\n";
                         if(length($removed_first_letter)>3){
                                my $gender = &gender($removed_first_le
+tter) || '';

                                    if ($gender eq 'f') { print "Email
+ : $email                   Matched with : $removed_first_letter     
+                   Gender: Female\n"; $flag=0;$count++; }
                              elsif    ($gender eq 'm') { print "Email
+ : $email                   Matched with : $removed_first_letter     
+                   Gender: Male\n"; $flag=0; $count++;}
                                #else                   { print "$user
+: UNSURE\n"; break; }
                        }
                }
                }
        }

      }
print "$count";
regards,
samson.
[download]