Category: | text processing |
Author/Contact Info | parv_@yahoo.com |
Description: | This program massages the driving directions (in USA) for plain text printing (preferably in monospace font, w/ a blank line between each non empty line), with these priorities (in no particular order) ...
|
#!perl # This program massages the driving directions (in USA) for plain tex +t # printing (preferably in monospace font, w/ a blank line between eac +h non # empty line), with these priorities (in no particular order) ... # - up-case road names, exit numbers, places # - low-case everything else # - expand n, w, e, s to north, west, east, south # - shorten road type (like mailing address), e.g. 'road' to 'rd', ' +lane' to # 'ln', etc. # - removes the annoying 'go' from 'go <this much>' use warnings; use strict; my ( $geo_pos , $roads ) = ( get_geo_pos() , get_road() ); my @relative_pos = map uc( $_ ) , qw(left middle center right) ; # Got a better name for this variable? my $less_important_than_roads_places = qr{ \b ( bear | stay | head | continue | follow | go | take | turn | entry | ramp | (?: to | fore? )w[oa]rds? | on.?to | on | to | for | at | off? | then | t?here | from | an?d? | (?: h(?:ou)?r | min(?:ute)? | second | moment )s? | ph(?:one)? | fax | e.?mail | home | office | work | cell | mo +bile ) \b }xi; my $misc_edits = { 'and' => '&' , 'hour' => 'hr' , 'minutes?' => 'min' , 'seconds' => 'second' , 'phone' => 'ph' , 'fore?w[oa]rd' => 'forward' , 'toword' => 'toward' } ; { local $^I = '' ; while ( <> ) { s{ \s+ the \s+ }/ /xig; s{ \b go (?: \s+ for )? \s+ (\d) }/ $1/xige; $_ = uc $_; s{ (\d) \W* ( mi(?:le)? | ft) \b }/"$1~" . lc $2/xige; s{ $less_important_than_roads_places }/lc $1/xige; for my $map ( $roads , $geo_pos , $misc_edits ) { while ( my ( $k , $v ) = each %$map ) { s[ \b $k \b ]/$v/xig; } } for my $r ( values %$roads ) { s/\b $r \./$r/xig; } s/^[ \t]+//g; s/[ \t]+$//g; s/[ \t]+/ /g; print; } } sub get_geo_pos { my @points = qw( east west north south north-east north-west south-east south-west east-north east-south west-north west-south ) ; my %points ; foreach ( @points ) { m{^ ([a-z])[a-z]+ (?: \W+ ( [a-z])[a-z]+ )? $}xi; $points{ $2 ? "$1$2" : $1 } = uc $_ ; } return { %points }; } sub get_road { my %roads = ( 'avenue' => 'ave' , 'av' => 'ave' , 'circle' => 'crl' , 'court' => 'ct' , 'crt' => 'ct' , 'drive' => 'dr' , 'lane' => 'ln' , 'pk' => 'pike' , 'parkway' => 'pkwy' , 'pky' => 'pkwy' , 'road' => 'rd' , 'route' => 'rt' , 'street' => 'st' , 'tpk' => 'turnpike' , 'turn.?pk' => 'turnpike' ); $_ = uc $_ for values %roads; return { %roads }; } |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Massage the driving directions (in USA)
by liverpole (Monsignor) on Jun 18, 2006 at 19:03 UTC |
Back to
Code Catacombs