#!/usr/bin/perl require "cgi-lib.pl"; use IO::Socket; &ReadParse(*input); $name="scoutlas.cgi"; $URL_path="http://www.scoutlas.org/scoutlas/"; $feedback_address="scoutlas_a\@yahoo.com"; $logo="scoutlas_logo.gif"; #data files locations $feature_datafile="features.dat"; $links_datafile="feature_links.dat"; $pending_feature_datafile="pending_features.dat"; $custom_views_datafile="custom_views.dat"; $page_background_color="\#efe7de"; $box_background_color="\#f7f2ed"; $box_border_color="\#c6beb5"; #each value of this hash is a reference to an array #normal parentheses define an array: @a = (1,2,3,"abc") #square brackets define an array reference: $a = [1,2,3,"abc"] #later on, @$ is used to dereference the array: push @$a, "newvalue"; #the array itself specifies 5 things: #--center lon #--center lat #--image width (in decimal latitude degrees) #--image height (in decimal latitude degrees) #--a comment (some text describing this particular geographic area) %states=(AL => "Alabama", AK => "Alaska", AZ => "Arizona", AR => "Arkansas", CA => "California", CO => "Colorado", CT => "Connecticut", DE => "Delaware", FL => "Florida", GA => "Georgia", HI => "Hawaii", ID => "Idaho", IL => "Illinois", IN => "Indiana", IA => "Iowa", KS => "Kansas", KY => "Kentucky", LA => "Louisiana", ME => "Maine", MD => "Maryland", MA => "Massachusetts", MI => "Michigan", MN => "Minnesota", MS => "Mississippi", MO => "Missouri", MT => "Montana", NE => "Nebraska", NV => "Nevada", NH => "New Hampshire", NJ => "New Jersey", NM => "New Mexico", NY => "New York", NC => "North Carolina", ND => "North Dakota", OH => "Ohio", OK => "Oklahoma", OR => "Oregon", PA => "Pennsylvania", RI => "Rhode Island", SC => "South Carolina", TN => "Tennessee", TX => "Texas", UT => "Utah", VT => "Vermont", VA => "Virginia", WA => "Washington", SD => "South Dakota", WV => "West Virginia", WI => "Wisconsin", WY => "Wyoming" ); @months=("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); %feature_types_and_marker_colors = ("interesting place" => "blu", "camping spot" => "grn", "BSA unit" => "lgr", "BSA council" => "cyn","bsa district" => "cyn", "GSUSA unit" => "mag", "GSUSA council" => "pur", "other" => "gry"); %feature_types_and_marker_colors_hex = ("interesting place" => "\#639aff", "camping spot" => "\#00cf00", "BSA unit" => "\#00ff9c", "BSA council" => "\#31ffff", "bsa district" => "\#31ffff","GSUSA unit" => "\#ff65ff", "GSUSA council" => "\#9c65ff", "other" => "\#616161"); #these arrays define edge coordinates for the shapes of the various #mouse-aware map features. @xpoints_pin=(0,4,7,9,12,14,15,15,14,12,9, 7, 4, 2, 1, 1,2,0); @ypoints_pin=(0,3,2,2,3, 5, 8, 10,13,15,16,16,15,13,10,8,5,1); @xpoints_dot10=(0,3,4, 4, 2,-2,-4,-4,-2); @ypoints_dot10=(4,3,0,-2,-4,-4,-2, 2, 4); @xpoints_ball=(2,5,7,8, 8, 7, 5, 2,-1,-4,-6,-7,-7,-6,-4,-1); @ypoints_ball=(7,6,4,1,-2,-5,-7,-8,-8,-7,-5,-2, 1, 4, 6, 7); #default values $initial_img_lon=-97.824947; $initial_img_lat=39.306103; $initial_img_xsize_pix=400; $initial_img_ysize_pix=400; $initial_img_xsize_lon=45; $initial_img_ysize_lat=45; $click_area_radius=10; $min_pixel_dist=20; #minimum number of pixels between features for them #to appear as individual markers on the map $pin_boundary=3; #maximum map width (in decimal lat. degrees) for features #to show up as big pins $new_feature_time=604800; #the amount of time (in seconds) for a feature to be #considered "new" (displayed in a different color) $num_points=20; #number of points to use for each line $rightnow=time(); #$PI=3.141592654; #$PI=3.141592653589793; $PI=3.14; #evaluate browser type and version $_ = $ENV{HTTP_USER_AGENT}; if (/Mozilla/) { if (/Opera.([0-9\.]+)/) { $browser_type = 'Opera'; $browser_version=$1;} elsif (/MSIE.([0-9.]+)/) { $browser_type = 'IE'; $browser_version = $1;} elsif (/Mozilla\/([0-9\.]+)/) {$browser_type = 'Mozilla'; $browser_version=$1; if (($browser_version<5) || (/Netscape/)) {$browser_type = "Netscape";} } if (/\)[^0-9.]+[0-9]*[\/\ ]([0-9.]+)/) {$browser_version=$1;} } elsif (/(\w+)\/([0-9\.]+)/) {$browser_type = $1; $browser_version = $2} # before we evaluate inputs, we need check to see if this is a murl_list request # and if so, perform some decoding on the inputs before we evaluate their values. #for some reason, the TMS server truncates anything in the URL following an #'&'. This means #that only the first parameter will get through. This happens to be the "action" parameter. #But we need the rest of the parameters for calculating groups and #other stuff. So we replace every '&' with '|'. This causes the entire parameter string #to appear like one really big "action" parameter #to detect and respond to this, we look at the first four characters #of the "action" parameter. If they are "murl", we then break down the rest of the string #and map the '|'s back to '&'s and decode the parameter string like normal. $temp=substr $input{'action'}, 0, 4; if ($temp eq "murl") { #put all the parameters in an array @parameters= split ('\|', $input{'action'}); #for each parameter element, split it into key-value pairs, and store in %input hash foreach $parameter (@parameters) { ($key, $value) = split ('\=', $parameter); $input{$key}=$value; } } #translate street address to lat/lon if ($input{'street_address'} ne "" || $input{'city_state_zip'} ne "") { &translate_street_address(); } #if a preselected view request, get the data for that view if ($input{'action'} eq "custom_view") { open (datafile, "$custom_views_datafile") || print ("could not open custom views data file"); flock datafile,2; @custom_views=; close datafile; foreach $line (@custom_views) { ($cv_id) = split ('\|', $line); if ($cv_id eq $input{'cv_id'}) { ($cv_id, $cv_label, $input{'img_lon'}, $input{'img_lat'}, $input{'img_xsize_lon'}, $input{'img_ysize_lat'}, $message_string) = split ('\|', $line); &decode(*message_string); } } } #evaluate inputs (for navigation) if ($input{'img_xsize_pix'} eq "") {$img_xsize_pix=$initial_img_xsize_pix; } else {$img_xsize_pix=$input{'img_xsize_pix'}; } if ($input{'img_ysize_pix'} eq "") {$img_ysize_pix=$initial_img_ysize_pix; } else {$img_ysize_pix=$input{'img_ysize_pix'}; } #limit image size to 3000 by 3000 if ($input{'img_xsize_pix'} > 3000) {$input{'img_xsize_pix'} = 3000; } if ($input{'img_ysize_pix'} > 3000) {$input{'img_ysize_pix'} = 3000; } if ($input{'img_xsize_lon'} eq "") {$img_xsize_lon=$initial_img_xsize_lon; } else {$img_xsize_lon=$input{'img_xsize_lon'}; } if ($input{'img_ysize_lat'} eq "") {$img_ysize_lat=$initial_img_ysize_lat; } else {$img_ysize_lat=$input{'img_ysize_lat'}; } #here is the place to expand img_ysize_lat or img_xsize_lon if the image is non-square #it's not being done right now, because the murl_url is calculated before the page is generated, #so the user can't change xsize_pix and ysize_pix dynamically and have it work. #there is probably a way around this, but it is a low priority if ($input{'img_lat'} eq "") { $img_lat=$initial_img_lat; $img_lon=$initial_img_lon; } else { &pixels_to_latlon(*img_lat, *img_lon, #return lat/lon $input{'img_lat'}, $input{'img_lon'}, #orignal img lat/lon $input{'dx'}, $input{'dy'}, #delta x and y from img center $img_xsize_pix, $img_ysize_pix, $img_xsize_lon,$img_ysize_lat ); } #this must be done before we calculate the image bounding lat/lon if ($input{'action'} eq "zoom") { $img_xsize_lon /= $input{'xzoom'}; $img_ysize_lat /= $input{'yzoom'}; } if ($img_ysize_lat < $pin_boundary) { $f_marker_type="pin"; $f_marker_width=16; $f_marker_height=18; } else { $f_marker_type="dot10"; $f_marker_width=10; $f_marker_height=11; } #determine image upper,lower,left,right boundaries in terms of lat/lon #we are going to occasionally miss some visible features that should appear #in the corners, due to the sinusoidal map projection vs. the square #bounds calculation here. $img_top_bound_lat=$img_lat+$img_ysize_lat/2; #increased lat=north=up $img_bottom_bound_lat=$img_lat-$img_ysize_lat/2; #this is complex...something doesn't seem right, like why #the img_xsize_lon term isn't divided by two, but this is definitely #what works (confirmed by trial & error) $img_left_bound_lon=$img_lon-$img_xsize_lon*cos($img_lat*$PI/180); $img_right_bound_lon=$img_lon+$img_xsize_lon*cos($img_lat*$PI/180); #TMS murl request if ($input{'murl_list'} eq "1") { &murl_list(); } #if a message was passed, grab it if ($input{'message_string'} ne "") { $message_string = $input{'message_string'}; } print< p1 #more info request if ($input{'action'} eq "more_info") { &more_info(); exit(0); } #custom map if ($input{'action'} eq "custom_map") { &custom_map(); exit(0); } #find if ($input{'action'} eq "find") { &find(); exit(0); } #search if ($input{'action'} eq "search") { &search(); exit(0); } #send to friend if ($input{'action'} eq "send_to_friend") { &send_to_friend(); exit(0); } #add feature if ($input{'action'} eq "add_feature") { &add_feature(); exit(0); } #administer pending features if ($input{'action'} eq "administer_pending_features") { &administer_pending_features(); exit(0); } #view new location if ($input{'action'} eq "view_new_location") { &view_new_location(); exit(0); } if ((scalar keys %input) == 0) { &welcome_view(); exit(0); } #default page &display_normal(); exit(0); sub display_normal { print<Scoutlas p1 &resolve_features(); #display header? &create_murl_url(); #display common javascript (the bulk of it) &common_javascript(); #display misc. browser-appropriate javascript if ($browser_type eq "IE") { &IE_javascript(); } else { &NS6_javascript(); } #print the rest of the display_default HTML print< p1 my $x_temp=0; my $y_temp=0; if (1) #set to 0 to disable click detection { #decide what shape to draw the feature marker in if ($img_ysize_lat < $pin_boundary) { $xpoints=\@xpoints_pin; $ypoints=\@ypoints_pin; } else { $xpoints=\@xpoints_dot10; $ypoints=\@ypoints_dot10; } #we reverse the array so overlapping lone features that will have #mouse-sensitive areas that overlap the same way the images do foreach $lf (reverse @lone_features) { #here, we draw a polygon around each visible feature marker. #the polygons should match exactly the outlines of the markers #this is how people can click on the markers and get info about the #features they represent. print< p1 } foreach $group_num (keys %groups) { #here, we draw a polygon around each group. print< p1 } #define a rectangle covering the entire map, used to detect clicks for zooming/panning print< p1 } print<
About Scoutlas

Email the administrator
Map

p1 if ($message_string ne "") { print< $message_string p1 } print<
Map Information
Mouse pointer information:
Mouse off map

Feature Information
When you click on a feature or feature group, information about it will be displayed here.

Controls
Clicking on the map will:
recenter map
recenter & zoom
Zoom Level:
Zoom in        Zoom out
← ← | → →
x4        x2              2x        4x

Other Options Administrator Options
  • Add a New Feature!
  • Custom Map
  • Search & Find
  • Email this map to a friend
    		•
  • New Feature Queue

    • Legend
    p1 @feature_types = sort {$a cmp $b} (keys %feature_types_and_marker_colors); $index=0; foreach $f (@feature_types) { #display a pin and a dot10 for each feature type print< $f
    p1 $index++; if (($index/5) == int ($index/5)) #change the $index/ number to the number of legend entries per column { print "    		" } } print< Feature Group p1 print<
    Features added within the last week


    p1 print< p1 } sub IE_javascript { print< p1 } #***********************end IE javascript************************" sub NS6_javascript { print< p1 } #********************end netscape javascript**********************" sub common_javascript { print<
    Make a Custom Map

    Current Map

    View / Hide Instructions

    Map Size
    Width: (In Pixels)
    Height: (In Pixels)










    Map Layers
    p1 foreach $layer (sort {$layers_and_definitions{$a} cmp $layers_and_definitions{$b}} (keys %layers_and_definitions)) { print "Off / On$layers_and_definitions{$layer}
    \n"; } print< Off/ OnScoutlas Features p1 print<
    Map this location with other internet mapping services
    Topozone™ Topo map
    Microsoft™ Terraserver Photo, topo & relief maps
    Suremaps™ Topo map
    p1 } #********************end custom_map code***************************** sub find { print<Scoutlas: Find Location/Feature
    Find a Location or Feature

    Find A Location

    There are two ways to find a place:

    Street Address
    City, State, ZIP 

    ..or..
    Latitude   
    Longitude
    		Find A Feature

    You can search all Scoutlas feature records for matching words:

    Search for:


    Pre-Selected Views



    p1 } #********************end find code***************************** sub welcome_view { print<Welcome to Scoutlas
    Welcome to



    General Information
    Scoutlas is a website for making and viewing maps.

    Specifically, maps of things related to scouting (Boy Scouts, Girl Scouts, etc).

    This site is intended as a resource for the public, and for scouting units in particular.

    p1 #read and display total features, links & pending features $num_features=0; open (datafile, "$feature_datafile") || print ("could not open feature data file"); flock datafile,2; while ($current_feature = ) { $num_features++; ($f_id, $f_lon, $f_lat, $f_type,)= split ('\|', $current_feature); $feature_totals{$f_type}++; } close datafile; $num_feature_links=0; open (datafile, "$links_datafile") || print ("could not open feature links data file"); flock datafile,2; while () { $num_feature_links++; } close datafile; #this starts at -1 to ignore the first line (password and timestamp) $num_pending_features=-1; open (datafile, "$pending_feature_datafile") || print ("could not open pending features data file"); flock datafile,2; while () { $num_pending_features++; } close datafile; print <Scoutlas currently has $num_features features, including:
  • $feature_totals{"camping spot"} camping spots
  • $feature_totals{"BSA council"} councils
  • $feature_totals{"BSA unit"} BSA units
  • $feature_totals{"interesting place"} interesting place
    p1 if ($num_pending_features >0) { #cheesy way to ensure good grammar $plural_s = ($num_pending_features >1) ? "s": ""; print< and $num_pending_features new feature$plural_s waiting for administrator approval. p1 } print<


    • About Scoutlas

    Email the administrator


    Please note that Scoutlas uses advanced javascript and will not work under most older browsers. It should work with the following brosers:
  • Microsoft Internet Explorer 5.0
  • Netscape 6
  • Mozilla .7

    If you are not running one of these, it would be a good idea to upgrade.
    		• Select a Place

    Choose from the following list of pre-selected views:



    Map A Location

    There are two ways to specify a place:
    Street Address
    City, State, ZIP 

    ..or..
    Latitude   
    Longitude


    Search for a Feature

    Search all Scoutlas features for matching words:

    Search for:


    p1 } #********************end welcome view code***************************** sub search { @label_matches=(); @comment_matches=(); %feature_labels={}; #this is just used for mapping ids to names %link_match_scores={}; #this is used for keeping track of comment match scores open feature_data, "$feature_datafile"; flock feature_data,2; #this is important, otherwise the OS may not allow the script to read if another process is using the datafile @features=; close feature_data; #this automatically undoes the flock 2 operation open link_data, "$links_datafile"; flock link_data,2; #this is important, otherwise the OS may not allow the script to read if another process is using the datafile @link_data=; close link_data; #this automatically undoes the flock 2 operation #look for feature matches foreach $feature (@features) { #grab info from the current line ($f_id, $f_lon, $f_lat, $f_type, $f_label, $f_timestamp)= split ('\|', $feature); $feature_labels{$f_id}=$f_label; $match_score=wmatch($input{'search_terms'},$f_label); # print "searching $a_title for $input{'search_terms'}... "; # print "got $title_results title results "; # print "got $description_results description results
    "; if ($match_score > 0) { push (@label_matches, {f_lat => $f_lat, f_lon => $f_lon, f_id => $f_id, f_label => $f_label, match_score => $match_score}); } } #look for link matches foreach $current_link (@link_data) { ($l_id, $l_URL, $l_comment)=split ('\|', $current_link); $match_score=&wmatch ($input{'search_terms'},$l_comment); #$match_score+=&wmatch ($input{'search_terms'},$l_URL); if ($match_score > 0) { $link_match_scores{$l_id} += $match_score; push (@link_matches, { l_id => $l_id, l_data => $link_data}); } } print <Scoutlas Feature Search:
    Scoutlas Feature Search
    for "$input{'search_terms'}"

    p1 if (scalar @label_matches>0) { print <Feature Name Matches:
    p1 for $label_match (sort {$::b->{match_score} <=> $::a->{match_score} } @label_matches) { print <$$label_match{f_label}
    p1 } print "


    "; } if (scalar @link_matches>0) { print <Link & Comment Matches:
    p1 for $matched_link_id (sort {$link_match_scores{$b} <=> $link_match_scores{$a}} keys %link_match_scores) { if (abs $matched_link_id != 0) { print<$feature_labels{$matched_link_id}
    p1 } } print "


    "; } if (scalar @label_matches == 0 && scalar @link_matches == 0) { print "Rats! No features had names or links matching your search terms." } print< Email questions, comments, corrections or requests to the Administrator
    p1 } #********************end search code***************************** sub add_feature { $pf_lon=$input{'pf_lon'}; $pf_lat=$input{'pf_lat'}; $pf_type=$input{'pf_type'}; $pf_label=$input{'pf_label'}; $pf_timestamp=$rightnow; $pf_email=$input{'pf_email'}; $pf_l_URL=$input{'pf_l_URL'}; $pf_l_desc=$input{'pf_l_desc'}; &encode(*pf_l_desc); if ($input{'p1'} eq "confirmed") { #read pending feature data open (datafile, "$pending_feature_datafile") || print ("unable to open pending_features data file for reading"); flock datafile,2; @pending_features=; close datafile; #generate next pending feature id ($pf_id) = (split ('\|', $pending_features[-1])); $pf_id++; #check current feature against all previous pending features #in case of browser refreshes. $dup=0; foreach $previous_feature (@pending_features) { ($pre_id, $pre_lon, $pre_lat, $pre_type, $pre_label, $pre_timestamp, $pre_email, $pre_l_URL, $pre_l_desc)= split ('\|', $previous_feature); # $debug_info .=< #$pre_lon and $pf_lon
    #$pre_lat and $pf_lat
    #$pre_type and $pf_type
    #$pre_label and $pf_label
    #$pre_l_URL and $pf_l_URL
    #$pre_l_desc and $pf_l_desc

    #p1 #compare with current values if ($pre_lon eq $pf_lon && $pre_lat eq $pf_lat && $pre_type eq $pf_type && $pre_label eq $pf_label && $pre_l_URL eq $pf_l_URL && $pre_l_desc eq $pf_l_desc ) { $dup=1; last; } } if ($dup != 1) { #compute pf_string. $pf_string="$pf_id|$pf_lon|$pf_lat|$pf_type|$pf_label|$pf_timestamp|$pf_email|$pf_l_URL|$pf_l_desc|"; #open pending features data file for writing open (datafile, "+>>$pending_feature_datafile") || print ("unable to open pending_features data file for writing"); flock datafile,2; #do the write print datafile ($pf_string,"\n"); close datafile; } &administer_pending_features(); } if ($input{'p1'} eq "confirm") { #here, we check for naughty words $filter_string="$input{'f_label'} $input{'f_type'} $input{'contact_email'} $input{'l_URL'} $input{'l_desc'}"; $filter_result=&content_filter($filter_string); if ($filter_result ne "pass") { print <Add Feature Error Error. Your submission failed the content filter.

    $filter_result

    Hit the "back" button on your browser to return to the previous page and try again. p1 exit(0); } #here we check for blank fields for a new feature if ($input{'f_label'} eq "" || $input{'f_type'} eq "") { print <Add Feature Error Error. You did not include both a name and type for the feature.

    Hit the "back" button on your browser to return to the previous page and try again. p1 exit(0); } #here we check for blank fields for a new link if ($input{'f_type'} eq "feature_link" && ($input{'l_URL'} eq "" || $input{'l_desc'} eq "")) { print <Add Link Error Error. You did not include both an URL and a description for the link.

    Hit the "back" button on your browser to return to the previous page and try again. p1 exit(0); } #remove http:// from url $input{'l_URL'} =~ s/http:\/\///g; if ($input{'f_type'} eq "feature_link") { print<Scoutlas: Add Link Confirmation
    Add Link Confirmation

    Please double-check the link information.
    Click "Confirm" if everything is correct.

    p1 &display_link($input{'l_URL'}, $input{'l_desc'}); print< p1 exit(0); } else { print<Scoutlas: Add Feature Confirmation
    Add Feature Confirmation

    Please double-check the feature information
    (especially the link, if you submitted one).
    Click "Confirm" if everything is correct.

    Feature Name: $input{'f_label'}
    Feature Type: $input{'f_type'}
    Lat: $input{'f_lat'}
    Lon: $input{'f_lon'}


    p1 if ($input{'l_URL'} ne "") {&display_link($input{'l_URL'}, $input{'l_desc'});} print< p1 } exit(0); } print<Scoutlas: Add Feature
    Add a feature to Scoutlas

    New Feature Preview
    		 Instructions
    Your new feature will appear exactly where the red star is.

    Step 1: Make sure it is in the right place. If not, back up to the main page, and center the map on where the new feature should be.

    Zooming in results in better accuracy. However, if you zoom in too much (closer than street-level), you will get strange results, due to the limitations of lat/lon precision. So don\'t go crazy trying to pinpoint your feature to the exact inch.

    Once you are satisfied with the placement, re-click "Add a New Feature" to return to this page.

    If the red star is at the correct spot right now, you are ready for the next step:



    Step 2: Feature Information
    Scoutlas only records two pieces of information about each feature:

    Feature Name:
    Feature Type:


    Step 3: Email address?
    You might want to list an email address to contact you. This is used if there is any question or concern about your submission. It is written to a data file, but never displayed on a web page. It is deleted once the feature is added to the database. It is not kept, given or sold to anyone.

    Your Email Address



    Step 4: Feature Link(s)
    Links can be attached to each feature. A link consists of an URL and a short description.

    After you submit a feature, and it is added to the database, you (and others) will be able to add more links.

    You don\'t have to add a link now, but it is a good idea.

    Link URL:

    Short description of link:




    p1 } #********************end add_feature code***************************** sub administer_pending_features { open (datafile, "$pending_feature_datafile") || die ("unable to open pending_features data file for writing"); flock datafile,2; @pending_features=; close datafile; $first_line= shift @pending_features; ($adm_password, $last_updated) = split ('\|', $first_line); $salt = substr($input{'adm_password'}, 0, 2); $input_password = crypt $input{'adm_password'}, $salt; #print "first line=$first_line
    "; #print "adm_password=$adm_password
    "; #print "input password=$input_password
    "; #check password if( $input_password ne "" && $input_password eq $adm_password) #encrypt password { #need to check current feature against all previous pending features #in case of browser refreshes. @approved_features = (); @still_pending_features = (); #sort each pending feature into two piles: update and no-update foreach $pending_feature (@pending_features) { ($pf_id) = (split ('\|', $pending_feature)); if ($input{$pf_id} eq "approve") { #sort pending_feature into "approved" pile push @approved_features, $pending_feature; #print "feature $pf_id approved for adding

    "; } elsif ($input{$pf_id} ne "delete") { push @still_pending_features, $pending_feature; } } #write approved features to main files open (datafile, "$feature_datafile") || print ("unable to open feature data file for reading"); flock datafile,2; @features=; close datafile; #generate beginning feature id for approved features ($f_id) = (split ('\|', $features[-1])); $f_id++; foreach $approved_feature (@approved_features) { #need to check current feature against all previous pending features #in case of browser refreshes. ($pf_id, $pf_lon, $pf_lat, $pf_type, $pf_label, $pf_timestamp, $pf_email, $pf_l_URL, $pf_l_desc)= split ('\|', $approved_feature); if ($pf_type eq "feature_link") { #write link #print "writing $pf_type $pf_id to datafile
    "; open (datafile, "+>>$links_datafile") || print ("could not open links datafile for writing\n"); #for links, the feature id is stored in the lat field. pf_lat is not a typo print datafile "$pf_lat|$pf_l_URL|$pf_l_desc|\n"; close datafile; } else { #write feature #print "writing feature $pf_id to datafile
    "; open (datafile, "+>>$feature_datafile") || print ("could not open feature datafile for writing\n"); #notice that $pf_timestamp has been replaced with $rightnow print datafile "$f_id|$pf_lon|$pf_lat|$pf_type|$pf_label|$rightnow|\n"; close datafile; #write link if ($pf_l_URL ne "") { # print "writing link $pf_l_URL to datafile
    "; open (datafile, "+>>$links_datafile") || print ("could not open links datafile for writing\n"); print datafile "$f_id|$pf_l_URL|$pf_l_desc|\n"; close datafile; } $f_id++; } } #write still-pending features back to pending feature file open (datafile, ">$pending_feature_datafile") || print ("unable to open pending_features data file for writing"); flock datafile,2; print datafile $first_line; foreach $non_approved_feature (@still_pending_features) { print datafile $non_approved_feature; } close datafile; open (datafile, "$pending_feature_datafile") || die ("unable to open pending_features data file for writing"); flock datafile,2; @pending_features=; close datafile; $first_line= shift @pending_features; } print<Scoutlas: New Feature Queue
    New Feature Queue

    Back to Scoutlas main page

    Features submitted online must be approved by an administrator before they will show up on the map.

    p1 if (scalar @pending_features < 1) { print<At this time, there are no features waiting to be approved! p1 exit(0); } print< Administrators: If you click "Approve" or "Delete" accidentally, you can refresh your browser or click on "Add / Delete Marked Features" without typing the correct password. Either of these actions will erase all checkboxes.


    p1 #display something if an invalid password was entered if( $input_password ne "" && $input_password ne $adm_password) { print "An invalid administrator password was entered.
    "; } #reverse array, so features are listed most recent first foreach $pending_feature (reverse @pending_features) { ($pf_id, $pf_lon, $pf_lat, $pf_type, $pf_label, $pf_timestamp, $pf_email, $pf_l_URL, $pf_l_desc)= split ('\|', $pending_feature); my $nice_date = &formatted_time($pf_timestamp, "mn dd,yy"); print< Approve p1 if ($pf_type eq "feature_link") { #if a new link print< New link for $pf_label
    Submitted on: $nice_date
    p1 } else { #if a new feature print< New Feature:
    Name: $pf_label
    Type: $pf_type
    Lat: $pf_lat
    Lon: $pf_lon
    View Location
    Submitted on: $nice_date
    p1 } if($pf_l_URL ne "") { &decode(*pf_l_desc); $pf_l_desc =~ s/\n/
    /g; print<
    $pf_l_URL p1 } else { print "No link
    "; } print< Delete
    p1 } print<Administrator Password:

    p1 exit(0); } #*******************end administrator pending features code********** sub send_to_friend { if ($input{'p1'} eq "send") { print<Email map confirmation
    Email map confirmation


    p1 #check for empty fields if ($input{'to_address'} eq "" || $input{'from_address'} eq "" || $input{'subject'} eq "" || $input{'body_text'} eq "") { print<Error. One or more of the fields was blank.



    $filter_result

    Hit the "back" button on your browser to return to the previous page and try again. p1 } #check for well-formed email address? #send email else { &send_email($input{'to_address'},$input{'from_address'}, $input{'subject'},$input{'body_text'}); print<
    Back to Scoutlas main page

    p1 } print< p1 } else { print<Email map to friend
    Email map to a friend


    Email Information:
    (all fields must be filled in)
    Destination Email address (send to):
    Your own email address (sent from):
    Subject:

    Body text:


    p1 } } #*******************end administrator pending features code********** sub view_new_location() { print<Location for new feature
    Add a feature to Scoutlas

    Location for new feature
    The new feature will appear exactly where the red star is.


    p1 } #*******************end view new location code********** #*******************the following subroutines don't display any HTML********** #*******************they perform common tasks for other subroutines ********** sub display_link { ($l_URL, $l_desc) = @_; &decode(*l_desc); $l_desc =~ s/\n/
    /g; print< $l_desc

    $l_URL p1 } sub translate_street_address { $hostname ="www.mapblast.com"; $document = "/myblast/map.mb"; $postdata = <new( Proto => "tcp", PeerAddr => $hostname, PeerPort => "http(80)", ); unless ($remote) { die "cannot connect to http daemon on $host" } $remote->autoflush(1); print $remote "POST $document HTTP/1.0\n"; print $remote $postdata; print $remote "\n\n"; @textbuffer=<$remote>; #close $remote; my $textstring = join "", @textbuffer; #truncate everything before lat/lon $textstring =~ s/^.+Lat: //s; my $lat=$textstring; my $lon=$textstring; #get lat $lat =~ s/.+Lat://s; $lat =~ s/\ .+//s; #get lon $lon =~ s/^.+Lon: //s; $lon =~ s/<.+//s; #check for successful translation $test=$lat+$lon+0; if ($test == 0) { $message_string = <Unable to translate
    $input{'street_address'}
    $input{'city_state_zip'}
    to lat / lon coordinates.
    p1 } else { $message_string = < $input{'street_address'}
    $input{'city_state_zip'}

    Translated to
    Latitude: $lat
    Longitude: $lon
    p1 $input{'img_lat'}=$lat; $input{'img_lon'}=$lon; #if a street address, zoom in to street level #otherwise, zoom in to city level if ($input{'street_address'} ne "") { $input{'img_xsize_lon'}=.03; $input{'img_ysize_lat'}=.03; } else { $input{'img_xsize_lon'}=.3; $input{'img_ysize_lat'}=.3; } } } sub murl_list { print<
    debug information:\n\n

    $debug_info\n"; exit(0); } sub encode { local (*input_string) = @_; $input_string =~ s/(\W)/"\%".sprintf("%02x", (ord $1))/ge; $input_string =~ s/\%20/+/g; } sub decode { local(*input_string) = @_; $input_string =~ s/\+/ /g; $input_string =~ s/%([0-9A-Fa-f]{2})/pack("c",hex($1))/ge; } sub latlon_to_pixels { #lon = x = <-> #lat = y = up-down # -- make sure point is within image (not yet implemented) # -- compute y pixel coordinate # -- compute x pixel coordinate (using the y coordinate, since longitude values # are mutiplied by a cos(y_lat) term #assuming - x + # - # y # + # $local $LU_PER_DEC_DEG = 1000000; local (*xpos, *ypos, $point_lat, $point_lon, $img_center_lat, $img_center_lon, $img_xsize_pix, $img_ysize_pix, $img_xsize_lon, $img_ysize_lat )=@_; $pixels_per_dec_deg_lat=$img_ysize_pix/$img_ysize_lat; $pixels_per_dec_deg_lon=$img_xsize_pix/$img_xsize_lon*(cos($point_lat*$PI/180)); $temp=(cos($point_lat*$PI/180)); $ypos=int(($img_ysize_pix/2)+($img_center_lat-$point_lat)*$pixels_per_dec_deg_lat); $xpos=int(($img_xsize_pix/2)+($point_lon-$img_center_lon)*$pixels_per_dec_deg_lon); } sub pixels_to_latlon { # $accuracy=100000000; local (*img_lat, *img_lon, #return lat/lon $prev_img_lat, $prev_img_lon, #orignal img lat/lon $dx, $dy, #delta x and y from img center $img_xsize_pix, $img_ysize_pix, $img_xsize_lon, $img_ysize_lat)=@_; if (0) { print<sub pixels_to_latlon
    input:
    prev_img_lat = $prev_img_lat
    prev_img_lon = $prev_img_lon
    dx = $dx
    dy = $dy
    img_xsize_pix = $img_xsize_pix
    img_ysize_pix = $img_ysize_pix
    img_xsize_lon = $img_xsize_lon
    img_ysize_lat = $img_ysize_lat
    p1 } $pixels_per_dec_deg_lat=$img_ysize_pix/$img_ysize_lat; $img_lat = $prev_img_lat - $dy/$pixels_per_dec_deg_lat; # $img_lat=int($img_lat*$accuracy)/$accuracy; $pixels_per_dec_deg_lon=$img_xsize_pix/$img_xsize_lon*(cos($img_lat*$PI/180)); $img_lon = $prev_img_lon + $dx/$pixels_per_dec_deg_lon; # $img_lon=int($img_lon*$accuracy)/$accuracy; if (0) { print<output
    img_lat = $img_lat
    img_lon = $img_lon

    p1 } } sub formatted_time { local($input_time, $format_string) = @_; local @input_time_array = gmtime ($input_time+0); local $ampm=""; if ($input_time_array[5]<1900) {$input_time_array[5]+=1900;} $month_name=$months[$input_time_array[4]]; $input_time_array[4]++; if ($input_time_array[1]<10) {$input_time_array[1]="0".$input_time_array[1];} if ($input_time_array[2]>12) #convert from 24-hour to am/pm { $input_time_array[2]=$input_time_array[2] - 12; $ampm="pm"; } else { $ampm="am"; } $format_string =~ s/ampm/$ampm[2]/g; $format_string =~ s/hh/$input_time_array[2]/g; $format_string =~ s/mm/$input_time_array[1]/g; $format_string =~ s/mo/$input_time_array[4]/g; $format_string =~ s/mn/$month_name/g; $format_string =~ s/dd/$input_time_array[3]/g; $format_string =~ s/yy/$input_time_array[5]/g; return $format_string; } sub resolve_features { open (datafile, "$feature_datafile") || print ("could not open feature data file"); flock datafile,2; @features = ; close datafile; #initialize hashes for grouping features %group_totals={}; #initialize hashes for group screen positions %group_avg_xpos={}; %group_avg_ypos={}; #these should be temporary %group_avg_lon={}; %group_avg_lat={}; #the values of the %groups hash are references to arrays, each of which #is composed of references to hashes that contain the feature info #%groups={}; %group_stats={}; #we keep a separate array to contain the info for features not in a group @lone_features=(); $num_visible_features=0; $num_lone_features=0; $num_groups=0; foreach $feature (@features) { ($f_id, $f_lon, $f_lat, $f_type, $f_label, $f_timestamp)= split ('\|', $feature); #select visible features here. if ($f_lat<$img_top_bound_lat && $f_lat>$img_bottom_bound_lat && $f_lon>$img_left_bound_lon && $f_lon<$img_right_bound_lon) { #translate lat/lon to pixels for each visible feature &latlon_to_pixels(*f_x, *f_y, $f_lat, $f_lon, $img_lat, $img_lon, $img_xsize_pix, $img_ysize_pix, $img_xsize_lon, $img_ysize_lat ); # we need to do something to avoid mapping features that are too close # together to be distinguished. The best way is to "group" close- # together features into a single temporary feature. We calculate # the pixel values first, and use those values to do the grouping. # there are many ways to do the grouping, but most of them are very # CPU-intensive. I use one that takes advantage # of the fact that we can define how close in pixels two markers # are allowed to be without getting grouped. # This is defined as a global script variable. # we divide the image into a grid of squares, and we number them like so: #______________________ #|0 |1 |2 |3 |4 |. |N | #|__|__|__|__|__|__|__| #| | | | | |. |2N+1| #|__|__|__|__|__|__|__| #. |3N+2| #. |__| #. . #. . #. . #. ___ # |(N+1)*(N+1)| #. . . . . . . . . |___| # The width & height of each square is the mimimum pixel distance. # The value of N doesn't really matter. I just wanted to show that the # number of squares inside the grid is variable. Wway too much time # was spent making the diagram mathematically correct... # The grid is gauranteed to be at least as big as the image (for this # to work, the grid can be bigger than the image, but not smaller.) # Any squares with more than one feature inside will have those features # grouped together. # map f_x and f_y to the appropriate square # this is where the square grid algorithm pays off in # minimal CPU time. $group_num=int($f_x/$min_pixel_dist)+int($f_y/$min_pixel_dist)*int($img_ysize_pix/$min_pixel_dist); #print "group_num=$group_num

    "; # now, we use the square number as the key for a hash that keeps track # of all the squares having at least one feature within if ($rightnow-$f_timestamp > $new_feature_time) { $group_totals{$group_num}++; } push (@visible_features, {f_id => $f_id, f_lon => $f_lon, f_lat => $f_lat, f_x => $f_x, f_y => $f_y, f_type => $f_type, f_label => $f_label, f_timestamp => $f_timestamp, group_num => $group_num }); $num_visible_features++; } } $currentgroup=[]; #square brackets define an array reference $currentstats={}; #curly brackets define a hash referenct #put the visible features in groups or by themselves in a @lone_features array foreach $vf (@visible_features) { if ($group_totals{$$vf{group_num}} >1 && ($rightnow-$$vf{f_timestamp}) > $new_feature_time) { #get the reference to the appropriate group, or create a new reference if none exists $currentgroup=$groups{$$vf{group_num}}; #print "we should be adding feature $$vf{f_id} to group $$vf{group_num} now
    \n"; push @$currentgroup, $vf; #push vf, a reference to a hash, into the array referenced by $currentgroup $groups{$$vf{group_num}} = $currentgroup; #create or update the hash entry $currentstats=$group_stats{$$vf{group_num}}; $$currentstats{$$vf{f_type}}++; $group_stats{$$vf{group_num}} = $currentstats; } else { push (@lone_features,$vf); $num_lone_features++; } } $num_groups = scalar (keys %groups); #calculate the avg lat and lon for each group, then use it to find pixel values foreach $group_num (keys %groups) { $currentgroup=$groups{$group_num}; $lon_total=0; $lat_total=0; foreach $feature (@$currentgroup) { #print"\nfeature in group $group_num--lat: $$feature{f_lat}, lon: $$feature{f_lon}\n"; $lon_total += $$feature{f_lon}; $lat_total += $$feature{f_lat}; } $group_avg_lon{$group_num} = $lon_total/(scalar @$currentgroup); $group_avg_lat{$group_num} = $lat_total/(scalar @$currentgroup); #we use the group_avg_lon and lat to zoom in on a group #it will be useful to calculate the width of the group also $temp_x=0; $temp_y=0; &latlon_to_pixels(*temp_x, *temp_y, $group_avg_lat{$group_num}, $group_avg_lon{$group_num}, $img_lat, $img_lon, $img_xsize_pix, $img_ysize_pix, $img_xsize_lon,$img_ysize_lat ); $group_avg_xpos{$group_num}=$temp_x; $group_avg_ypos{$group_num}=$temp_y; } } sub content_filter { local($input_string) = @_; local $return_string=""; #the seven (or so) words you can't say, except in the code! if ($input_string =~ m/(damn|fuck|shit|bitch| dick | ass | cunt)/g) {return "fail";} else {return "pass";} } sub create_murl_url { $murl_url = <"; @awords=split(' ', $A); @bwords=split(' ', $B); $score=0; foreach $aword (@awords) { if ((index $B,$aword) != -1) { # print "$temp"; # print "pruned to \"$A\" and \"$B\"
    "; # print "wmatch matched $aword and $bword

    "; $score++; } } return $score; } sub send_email { ($to, $from, $subject, $body) = @_; $sendmail="/usr/sbin/sendmail"; open mail, "|$sendmail -t -oi"; print mail <