All pastes #804040 Raw Edit

Mine

public text v1 · immutable
·published 2007-12-03 01:26 UTC
rendered paste body
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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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/&nbsp;//;
    $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;