User:Xybot/FixStrasseDeAT

This is the Ruleset FixStrasseDeAT of the Xybot script

<source lang=perl> sub begin {

 my $me = shift;
 Data::Primitive->setCreator("FixStraßeDeAt");
 Data::Primitive->setComment('Korrektur der Schreibweise der Straßennamen in Deutschland und Österreich; Str(\.?|asse) => Straße');

}

sub process {

 my ($me, $obj) = @_;
 
 my $resultstr = "";
 my $work = $obj;
 my $clone = undef;

 die "FATAL  data is outside the bounding box of germany and austria - revert any changes already submitted" 
   if (ref($obj) eq "Data::Node" && !$obj->isInBox(47.267, 5.864, 55.090, 15.049) && !$obj->isInBox(46.384, 9.536, 49.003, 17.162));

 foreach $k ("name", "addr:street") {
   my $v=$work->{"tags"}->{$k};
   if (defined($v)) {
     my $gotcha=0;
     if( $v =~ /Ã./) {
       $gotcha++ if ($v =~ s/ä/ä/);                                                                   # Potlatch Krankheit ä
       $gotcha++ if ($v =~ s/ö/ö/);                                                                   # Potlatch Krankheit ö
       $gotcha++ if ($v =~ s/ü/ü/);                                                                   # Potlatch Krankheit ü
       $gotcha++ if ($v =~ s/Ä/Ä/);                                                                   # Potlatch Krankheit Ä
       $gotcha++ if ($v =~ s/Ö/Ö/);                                                                   # Potlatch Krankheit Ö
       $gotcha++ if ($v =~ s/Ãœ/Ü/);                                                                   # Potlatch Krankheit Ü
       $gotcha++ if ($v =~ s/ß/ß/);                                                                   # Potlatch Krankheit ß
     }
     $gotcha++ if ($v =~ s/^\s*(.+str)(\.?|asse)\s*$/$1aße/i ); 					# am ende [s|S]tr[.|] => [s|S]traße [s|S]trasse => [s|S]traße
     $gotcha++ if ($v =~ s/^\s*(.{4,}str|.{4,}(\s|-)Str)(\.?|asse)((\s+|,|;|\/).+)\s*$/$1aße$4/ );	# das ganze in der mitte, vor [ |,|;|/]
     $gotcha++ if ($v =~ s/^\s*(.{4,}(\s+|-))straße(.*)\s*/$1Straße$3/ );				# Großschreibung nach Leerstelle oder '-'
     $gotcha++ if ($v =~ /straße/i && ($v =~ s/\s{2,}/ /g || $v =~ s/-{2,}/-/g) );			# Mehrfache Leerstelle oder '-' durch einzelne ersetzen
     if ($gotcha) {
       $resultstr .= sprintf " - key '%s' modifying value '%s' to '%s'", $k, $work->{"tags"}->{$k}, $v;

       if (defined($work->{"tags"}->{"is_in"}) && $work->{"tags"}->{"is_in"} =~ /Schweiz|\s*CH\s*/) {

1. fs $obj->log(ref($obj), $work->{"id"}, $resultstr, "NOTICE not modifying - has tag 'is_in=".$work->{"tags"}->{"is_in"}."' ");

       } elsif (defined($work->{"tags"}->{"addr:country"}) && $work->{"tags"}->{"addr:country"} =~ /\s*CH\s*/) {

1. fs $obj->log(ref($obj), $work->{"id"}, $resultstr, "NOTICE not modifying - has tag 'addr:country=".$work->{"tags"}->{"addr:country"}."' ");

       } else {
         $clone=$work->clone() unless defined($clone);
         $clone->{"tags"}->{$k} = $v;
         $work=$clone;
       }
     }
     if ( $v =~ /^\s*stra(ss|ß)e\s*$/i ) {
       $clone=$work->clone() unless defined($clone);
       delete $clone->{"tags"}->{$k};
       $resultstr .= sprintf " - deleting meaningless tag '%s=%s'", $k, $v,
       $work=$clone;
     }
   }
 }