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;