use Strict;
use Warnings;
use LWP::Simple;
open DATASHEET, ">", "./datasheet.txt"
or die "Failed to open write file: $!\n";
print DATASHEET "F Name\tM Name\tL Name\tEmail\tPrim Spec\tDegree\tAddress\tCity\tState\tZip\tGender\tMed School\tPhone\tFax\tDSO.org Index\n";
my $content; # LWP variable for get ( ) method
my @webpage; # The response. THIS WILL REQUIRE CHANGING LINE NUMBERS DUE TO HEADERS
my @name_split; # To write each name (first, middle, last) to a separate column
my ($name, $email, $prime_specialty, $title, $address, $city,
$state, $zip, $gender, $med_school, $phone, $fax);
###################################################
# The code block to institute the loop and to ac- #
# cess the web page and all that. #
###################################################
for (my $x = $ARGV[0]; $x <= $ARGV[1]; $x++) {
$content = get "http://www.doctorsecondopinion.org/index.php?page=search_Doctor_Profile&index=$x";
die "Unknown error with LWP.\n" unless defined $content;
$content =~ s/\r//g;
@webpage = split /\n/, $content;
###################################################
# The following code reads the source of the page #
# and determines whether or not the doctor has an #
# email address. If (s)he does, it writes. #
###################################################
for (150..300) {
my $el = $_ if ($webpage[$_] =~ /mailto:/);
}
if ($webpage[$el] =~ /@.{1,}\./) { # Test for presence of an email address. Trust me on this one.
for (150..300) {
my $nl = $_+1 if ($webpage[$_] =~ /Name:/);
my $psl = $_+1 if ($webpage[$_] =~ /Primary Specialty:/);
my $tl = $_+1 if ($webpage[$_] =~ /Title:/);
my $al = $_+1 if ($webpage[$_] =~ /Address:/);
my $cl = $_+1 if ($webpage[$_] =~ /City:/);
my $sl = $_+1 if ($webpage[$_] =~ /State:/);
my $zl = $_+1 if ($webpage[$_] =~ /Zip:/);
my $gl = $_+1 if ($webpage[$_] =~ /Gender:/);
my $msl = $_+1 if ($webpage[$_] =~ /Medical School:/);
my $pl = $_+1 if ($webpage[$_] =~ /Phone:/);
my $fl = $_+1 if ($webpage[$_] =~ /Fax:/);
}
print "\nEmail address found!\n";
# THE FOLLOWING SEARCHES FOR AND PRINTS THE DOCTOR'S NAME
$name = $webpage[$nl];
$name =~ s/ //;
$name =~ s/[\w\s<]+>//; # Clean up the name (before name)
$name =~ s/<.+//; # More name clean up (after name)
@name_split = split(/\s/, $name);
if (scalar @name_split < 3) {
$name_split[2] = $name_split[1];
$name_split[1] = "";
}
if (scalar @name_split > 3) {
$name_split[2] = "$name_split[2] $name_split[$_]" for 3..(scalar (@name_split) - 1);
splice (@name_split, 3);
}
print "Name: $name\n";
print DATASHEET "$_\t" foreach @name_split; # Prints name to file
# NOW FOR THE EMAIL ADDRESS...
$email = $webpage[$el];
$email =~ s/ //;
$email =~ s/[\s\"\w=<>]+://; # Eliminates text before email addy
$email =~ s/\".+//; # Does the same for after addy
print "email address: $email\n";
print DATASHEET "$email\t"; # Prints email to file.
# PRIMARY SPECIALTY. BETTER HOPE THERE IS NO "SECONDARY SPECIALTY". THAT WOULD SUCK.
$prime_specialty = $webpage[$psl];
$prime_specialty =~ s/ //;
$prime_specialty =~ s/[\w\s<]+[b<>]{4}//; # Clean up the specialty (before)
$prime_specialty =~ s/<.+//; # More specialty clean up (after)
print "Primary Specialty: $prime_specialty\n";
print DATASHEET "$prime_specialty\t";
# DEGREE.
$degree = $webpage[$tl];
$degree =~ s/ //;
$degree =~ s/[\w\s<]+>//; # Clean up the degree (before)
$degree =~ s/<.+//; # More degree clean up (after)
print "Degree: $degree\n";
print DATASHEET "$degree\t";
# ADDRESS.
$address = $webpage[$al];
$address =~ s/ //;
$address =~ s/[\w\s<]+>//; # Clean up the address (before)
$address =~ s/<.+//; # More address clean up (after)
print "Address: $address\n";
print DATASHEET "$address\t";
# CITY.
$city = $webpage[$cl];
$city =~ s/ //;
$city =~ s/[\w\s<]+>//; # Clean up the city (before)
$city =~ s/<.+//; # More city clean up (after)
print "City: $city\n";
print DATASHEET "$city\t";
# STATE.
$state = $webpage[$sl];
$state =~ s/ //;
$state =~ s/[\w\s<]+>//; # Clean up the state (before)
$state =~ s/<.+//; # More state clean up (after)
print "State: $state\n";
print DATASHEET "$state\t";
# ZIP CODE.
$zip = $webpage[$zl];
$zip =~ s/ //;
$zip =~ s/[\w\s<]+>//; # Clean up the zip code (before)
$zip =~ s/<.+//; # More zip code clean up (after)
print "Zip Code: $zip\n";
print DATASHEET "$zip\t";
# GENDER.
$gender = $webpage[$gl];
$gender =~ s/ //;
$gender =~ s/[\w\s<]+>//; # Clean up the gender (before)
$gender =~ s/<.+//; # More gender clean up (after)
print "Gender: $gender\n";
print DATASHEET "$gender\t";
# MEDICAL SCHOOL.
$med_school = $webpage[$msl];
$med_school =~ s/ //;
$med_school =~ s/[\w\s<]+>//; # Clean up the med_school (before)
$med_school =~ s/<.+//; # More med_school clean up (after)
print "Medical School: $med_school\n";
print DATASHEET "$med_school\t";
# PHONE NUMBER.
$phone = $webpage[$pl];
$phone =~ s/ //;
$phone =~ s/[\w\s<]+>//; # Clean up the phone number (before)
$phone =~ s/<.+//; # More phone number clean up (after)
print "Phone Number: $phone\n";
print DATASHEET "$phone\t";
# FAX NUMBER.
$fax = $webpage[$fl];
$fax =~ s/ //;
$fax =~ s/[\w\s<]+>//; # Clean up the fax number (before)
$fax =~ s/<.+//; # More fax number clean up (after)
print "Fax Number: $fax\n";
print DATASHEET "$fax\t";
print "DSO.org Index: $x\n\n";
print DATASHEET "$x\n";
} else {
print "No email found at index $x\n";
}
}
close DATASHEET;