Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
Dear monks. Some years ago I write small program which can validate coordinates (locations on the Earth) from user input. I didn't to restrict format of input and I wanted support English as well as Finnish.
#!/usr/bin/perl use strict; sub conv { my $in = shift; $in =~ s/[NWSEIPL]//g; my $sign; if ($in =~ s/([-]+)//) { $sign = $1; } my $dd = $in; if ( $in =~ /([\d+-]+)\s+(\d+)\s+([\d\.]+)/ ) { $dd = $1 + $2/60 + $3/3600; } elsif ( $in =~ /([\d+-]+)\s+(\d+[\d\.]+)/ ) { $dd = $1 + $2/60; } if ($sign ) { $dd = -1 * $dd } return $dd; } sub bar { $_ = shift; print "\n$_\n"; my $comma_count =0; my $space_count =0; my $dot_count =0; my %H; my ($FIN, $ENG); my $err = 0; my @lst; my $latc = 1; my $lonc=1; my ($lat, $lon); #strip all unneeded tr/a-z/A-Z/; s/[^0-9NWSEIPL,.+-]/ /g; s/\s+/ /g; s/([NS])\s*([0-9. ]+)\s*,?\s*([EW])\s*([0-9. ]+)/$2$1,$4$3/; s/([EW])\s*([0-9. ]+)\s*,?\s*([NS])\s*([0-9. ]+)/$4$3,$2$1/; s/([PE])\s*([0-9. ]+)\s*,?\s*([IL])\s*([0-9. ]+)/$2$1,$4$3/; s/([IL])\s*([0-9. ]+)\s*,?\s*([PE])\s*([0-9. ]+)/$4$3,$2$1/; s/([0-9. ]+)\s*([NS])\s*,?\s*([0-9. ]+)\s*([EW])/$2$1,$4$3/; s/([0-9. ]+)\s*([EW])\s*,?\s*([0-9. ]+)\s*([NS])/$4$3,$2$1/; s/([0-9. ]+)\s*([PE])\s*,?\s*([0-9. ]+)\s*([IL])/$2$1,$4$3/; s/([0-9. ]+)\s*([IL])\s*,?\s*([0-9. ]+)\s*([PE])/$4$3,$2$1/; s/([0-9+-]+)\s+(\d+)\s+([0-9.]+)\s+([0-9+-]+)\s+(\d+)\s+([0-9.]+)/ +$1 $2 $3, $4 $5 $6/; s/([0-9+-]+)\s+([0-9.]+)\s+([0-9+-]+)\s+([0-9.]+)/$1 $2, $3 $4/; s/\s+/ /g; print "$_\n"; $comma_count = ($_ =~ tr/,//); $space_count = ($_ =~ tr/ //); $dot_count = ($_ =~ tr/.//); $H{E} = ($_ =~ tr/E//); $H{I} = ($_ =~ tr/I//); $H{P} = ($_ =~ tr/P//); $H{L} = ($_ =~ tr/L//); $H{W} = ($_ =~ tr/W//); $H{N} = ($_ =~ tr/N//); $H{S} = ($_ =~ tr/S//); $ENG = $H{W} + $H{N} + $H{S}; $FIN = $H{L} + $H{P} + $H{I}; if(($ENG >0) && ($FIN > 0)) { print "mixed languages\n"; $err++ } elsif (($FIN>0) && ( ($H{I}+$H{L})>1 || ($H{E}+$H{P})>1 )) { print "too many lats or lons\n"; $err++ } elsif (($ENG>0) && ( ($H{N}+$H{S})>1 || ($H{W}+$H{E})>1 )) { print "too many lats or lons\n"; $err++ } elsif ($H{E}>1) { print "too many E\n"; $err++ } elsif ($H{I}>1) { print "too many I\n"; $err++ } elsif ($H{L}>1) { print "too many L\n"; $err++ } elsif ($H{P}>1) { print "too many P\n"; $err++ } elsif ($H{W}>1) { print "too many W\n"; $err++ } elsif ($H{S}>1) { print "too many S\n"; $err++ } elsif ($H{N}>1) { print "too many N\n"; $err++ } elsif ($comma_count == 3) { my $n = 1; s/(,)/!--$n ? '.' : $1/ge; $n = 2; s/(,)/!--$n ? '.' : $1/ge; @lst = (split(/,/,$_)); } elsif ($comma_count == 2 && $space_count == 1) { s/ /./g; @lst = (split(/ /,$_)); } elsif ($comma_count == 2 && $space_count != 1) { s/,/./g; @lst = (split(/ /,$_)); } elsif ($comma_count == 1) { @lst = (split(/,/,$_)); } elsif ($comma_count > 3) { print "too many commas\n"; $err++ } elsif ($dot_count > 2) { print "too many dots\n"; $err++; } if ($ENG >0) { if (s/S//) { $latc=-1; } if (s/W//) { $lonc=-1; } s/[NE]//g; } elsif ($FIN >0) { if (s/E//) { $latc=-1; } if (s/L//) { $lonc=-1; } s/[IP]//g; } if($err > 0) { print "Err: $err\n"; $err=0; } else { $lst[0] =~ s/^\s+|\s+$//; $lst[1] =~ s/^\s+|\s+$//; $lat = conv($lst[0]); $lon = conv($lst[1]); $lat *= $latc; $lon *= $lonc; my $coords = "$lat, $lon"; if ($coords =~ /^[-+]?([1-8]?\d(\.\d+)?|90(\.0+)?),\s*[-+]?(18 +0(\.0+)?|((1[0-7]\d)|([1-9]?\d))(\.\d+)?)$/) { print "all ok\n"; } else { print "too big numbers\n"; } #Print even there is too big numbers in lat or lon print "LAT: $lat LON: $lon\n" } } #OK my @test =( 'N65, E25', '65P, I25', '25 E, 32 L', '65 0\' 45.414" N 25 28\' 17.231" E', '65 0\' 45.414" N, 25 28\' 17.231" E', 'S 65 0\' 45.414" W 25 28\' 17.231" ', 'S65 0\' 45.414" E, 25 28\' 17.231"', '47.9805, -116.5586', '47 58.8300 -116 33.5160', '47 58 49 -116 33 30', '50 58.8300 70 33.5160', '50 58.8300 -70 33.5160', '+50 58 83.00 70 33 77.44' ); for(@test) { bar($_); } undef(@test); #NOT OK print "\nNot ok cases\n"; my @test =( 'N65, N25', '65P, E25', '91, 47', '65P, W25', '100 E, 91 N', '47.9805, -186.5586', ); for(@test) { bar($_); }

In reply to Coordinate validator by timpoiko

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others having an uproarious good time at the Monastery: (10)
    As of 2019-10-21 10:16 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?