room

#! /usr/local/bin/perl -w
use strict;
use Data::Dumper;
use CGI::Carp qw( fatalsToBrowser );
use CGI;
use GD;
chdir '/package/twiki/rooms' or die "cannot scheinschdia. $!";
my $index='rooms-map.idx';
#my $it = (stat($index))[9];
#if ($it < (stat('src/rooms-map.obj'))[9]) {
#  mkindex();
#}
my $q = new CGI;
my $surl='http://twiki.molgen.mpg.de/foswiki/bin/room';
my $turl='http://twiki.molgen.mpg.de/foswiki/bin/view';
my $rurl='http://twiki.molgen.mpg.de/rooms';

my $room='';
my $hotspot='';
#  $q->param('room') and $room = $q->param('room');
if($ENV{PATH_INFO}) {
  my $p = $ENV{PATH_INFO};
  $p =~ s|^/||;
  ($room,$hotspot)=split(/\//,$p,2);
  $room    or $room    = '';
  $hotspot or $hotspot = '';
} 

print $q->header(-expires=>'now');
print $q->start_html(-title=>'Raumplaene MPI Molekulare Genetik');

#print $query->startform;
#print $query->textfield("srch","",25),"<BR>";
#print $query->endform;

#print $q->h1("$room/$hotspot");         # level 1 header
my %INDEX;
open I,"<$index" or mydie("cannot read $index: $!");
while(<I>) {
   chomp;
   @_=split(/\s+/,$_,2);
   next if ($_[0] eq '');
   # $Id: room,v 1.1 2011/03/03 16:11:30 twiki Exp twiki $ rooms-map-1.html
   if ($_[0] eq '$Id:') {
	@_ = $_[1] =~ m/(.*,v)\s+(\d+\.\d+\s+\S+\s+\S+)/;
   }
   $INDEX{$_[0]}=$_[1];
}
close I;

my $dummypage=$INDEX{'DUMMYPAGE'};
$dummypage and map { ($INDEX{$_} eq $dummypage) and delete($INDEX{$_}) } keys %INDEX;

$room =~ s/^-//;

my $error=0;
if (($hotspot ne '') and $hotspot =~ m/-?[OULRM]/) {
   if (exists $INDEX{$room}) {
      display_hotspot($hotspot,$room);
   } else {
      $error++;
   }
} elsif (exists $INDEX{$room}) {
   display_map($room);
} else {
   $error++;
}

if ($error) {
   if ($room ne '') {
      print $q->h1(qq"Raum $room existiert (noch) nicht.");
      print <<"__EOF__";
Eventuell ist der Raum nicht unter diesem Namen ($room) im Kartenmaterial verzeichnet.
Bitte kontaktieren sie Peter Marquardt ( mailto:marquardt_p\@molgen.mpg.de Fon: 1430 ) wenn
sie dazu Fragen oder Anregungen haben.
<p>
__EOF__

      mailtopeter($room);
   }
   display_startpage();
}


print $q->end_html;                  # end the HTML
print "\n";

exit;

sub pos_hs {
   my ($x1,$y1,$x2,$y2,$dx,$dy,$o)=@_;
   ($o eq  'M') and return ( (($x2+$x1)/2)-($dx/2) , (($y2+$y1)/2)-($dy/2) );
   ($o eq  'L') and return ( $x1-$dx               , (($y2+$y1)/2)-($dy/2) );
   ($o eq '-L') and return ( $x1                   , (($y2+$y1)/2)-($dy/2) );
   ($o eq  'R') and return ( $x2                   , (($y2+$y1)/2)-($dy/2) );
   ($o eq '-R') and return ( $x2-$dx               , (($y2+$y1)/2)-($dy/2) );
   ($o eq  'O') and return ( (($x2+$x1)/2)-($dx/2) , $y1-$dy               );
   ($o eq '-O') and return ( (($x2+$x1)/2)-($dx/2) , $y1                   );
   ($o eq  'U') and return ( (($x2+$x1)/2)-($dx/2) , $y2                   );
   ($o eq '-U') and return ( (($x2+$x1)/2)-($dx/2) , $y2-$dy               );
   return (undef,undef);
}

sub display_hotspot {
  my $hotspot=shift;
  my $room=shift;
  my $ori=$hotspot;
  my $p=$INDEX{$room};
  my $type;
  my $image;
  my $page;
  my @POLY=();
  my @HSXY=();

  my $gd_spot=GD::Image->newFromPng('spot.png',1);
  my ($dx,$dy)=$gd_spot->getBounds();

  open H,"<$p" or mydie("cannot open $p");
  while(<H>) {
    next unless(/<.?(IMG|MAP|AREA)/);
    if (/^<AREA SHAPE="(\S+)" COORDS="(\S+)" HREF="$room">$/) {
      $type = $1;
      my @tmp = split ",",$2;
      my ($x1,$y1,$x2,$y2);
      if ($type eq 'POLY') {
          ($x1,$y1,$x2,$y2)=(10000,10000,0,0);
	  while (@tmp) {
	     my $x=shift @tmp;
	     my $y=shift @tmp;
	     ($x < $x1) and $x1=$x;
	     ($x > $x2) and $x2=$x;
	     ($y < $y1) and $y1=$y;
	     ($y > $y2) and $y2=$y;
	  }
	  push @HSXY,pos_hs($x1,$y1,$x2,$y2,$dx,$dy,$ori); 
      } elsif ($type eq 'RECT') {
          ($x1,$y1,$x2,$y2)=@tmp;
	  push @HSXY,pos_hs(@tmp,$dx,$dy,$ori); 
      }
      if (defined($HSXY[0])) {
#	my $c = join(',',$x1,$y1,$x2,$y2);
	my $c = join(',',$HSXY[0],$HSXY[1],$HSXY[0]+$dx,$HSXY[1]+$dy);
	$page .= qq(<AREA SHAPE="RECT" COORDS="$c" HREF="$turl/Main/RaumHotSpots">\n);
      }
    }
    if (/<IMG SRC="(\S+)" USEMAP="\S+"/) {
       $image=$1;
       my $png = $room."_$hotspot.png";
       s/<IMG SRC="\S+" /<IMG SRC="$rurl\/pics\/$png" /;
    }
    s/USEMAP=".*(#.*)"/USEMAP="$1"/;
    if (/ HREF="(\S+)">/) {
       my $r=$1;
       if ($r =~ m/^-/) {
         s| HREF="\S+">| HREF="$surl/$r">|;
       } else {
	 $r=~s/\.//g;
	 s| HREF="\S+">| HREF="$turl/Main/RaumInfo$r">|;
       }
    }
    $page .= $_;
  }
  if (defined($HSXY[0])) {
     #
     # machst GD; laedst du original;
     #
     #
     my $image_png = $image;
#     $image_png =~ s/\.gif$/.png/; 
     my $im=GD::Image->newFromPng($image_png,1);

     my $white = $im->colorClosest(255,255,255); # find white
     $gd_spot->transparent($white);
     my $blue = $im->colorAllocate(0,0,255);
     my $yellow = $im->colorAllocate(255,255,0);
     # copy transparent over painted
     while (@HSXY) {
	my ($x,$y) =(shift @HSXY,shift @HSXY);
#	$page .= "<PRE>[$x,$y]</PRE>";
	$im->copyMerge($gd_spot,$x,$y,0,0,$dx,$dy,70);
	$im->string(gdLargeFont,($x+5),($y+($dy/2)-7),'HIER',$yellow);
     }

     my $png = "pics/$room.png";
     ($hotspot ne '') and $png = $room."_$hotspot.png";
     open O,">pics/$png";
     print O $im->png;
     close O;
  }  
  
  print "<!--";
  print "-->\n";
  print $page;
}


sub display_startpage {
  my $p="rooms-select.html";
  open H,"<$p" or mydie("cannot open $p");
  while(<H>) {
    next unless(/<.?(IMG|MAP|AREA)/);
    s/USEMAP=".*(#.*)"/USEMAP="$1"/;
    s| HREF="| HREF="$surl/|;
    s|IMG SRC="(.*?).gif"|IMG SRC="$rurl/$1.png"|;
    print $_;
  }
}

sub display_map {
  my $room=shift;
  my $p=$INDEX{$room};
  my $VERSION=$INDEX{"$p,v"}||'n/a';
  my $type;
  my $image;
  my $page;
  my @POLY=();
  open H,"<$p" or mydie("cannot open $p");
  while(<H>) {
    next unless(/<.?(IMG|MAP|AREA)/);
    if (/^<AREA SHAPE="(\S+)" COORDS="(\S+)" HREF="$room">$/) {
      $type = $1;
      my @tmp = split ",",$2;
      my $shape;
      if ($type eq 'POLY') {
          $shape = new GD::Polygon;
	  while (@tmp) {
	     my $x=shift @tmp;
	     my $y=shift @tmp;
	     $shape->addPt($x,$y);
	  }
	  push @POLY,$shape;
      } elsif ($type eq 'RECT') {
          $shape = new GD::Polygon;
	  my ($x1,$y1,$x2,$y2)=@tmp;
	  $shape->addPt($x1,$y1);
	  $shape->addPt($x2,$y1);
	  $shape->addPt($x2,$y2);
	  $shape->addPt($x1,$y2);
	  push @POLY,$shape;
      }
    }
    if (/<IMG SRC="(\S+)" USEMAP="\S+"/) {
       $image=$1;
       s/<IMG SRC="\S+" /<IMG SRC="$rurl\/pics\/$room.png" /;
    }

    s/USEMAP=".*(#.*)"/USEMAP="$1"/;
#    s| HREF="| HREF="$surl/|;
    if (/ HREF="(\S+)">/) {
       my $r=$1;
       if ($r =~ m/^-/) {
         s| HREF="\S+">| HREF="$surl/$r">|;
       } else {
	 $r=~s/\.//g;
	 s| HREF="\S+">| HREF="$turl/Main/RaumInfo$r">|;
       }
    }
    $page .= $_;
  }

  #
  #
  # machst GD; laedst du original;
  #
  #
  my $image_png = $image;
  $image_png =~ s/\.gif$/.png/; 
#  print "# Image: $image_png\n";
  my $im=GD::Image->newFromPng($image_png,1);
  
  my $white = $im->colorClosest(255,255,255); # find white
  my $tr=$im->clone();
  $tr->transparent($white);

  my $red = $im->colorAllocate(255,0,0);
  for my $poly (@POLY) {
     $im->filledPolygon($poly,$red);
  }
  # copy transparent over painted
  my @wh=$im->getBounds();
  $im->copyMerge($tr,0,0,0,0,@wh,70);
#   $im->string(gdTinyFont,300,54,$VERSION,$red);

  open O,">pics/$room.png";
  print O $im->png;
  close O;

  print $page;
}

sub mydie {
  my $m=shift;
  print "<HR><PRE>";
  print "Error: $m";
  print "</PRE>";

  print $q->end_html;                  # end the HTML
  exit;
}

sub mkindex {
  my $REFMAP;
  for my $html (<rooms-map-*.html>) {
    open H,"<$html" or mydie("cannot read $html. $!");
    while(<H>) {
       if (/HREF="(.*)"/) {
          unless ($1 =~ m/^-/) {
              if (exists $REFMAP->{$1} and $REFMAP->{$1} ne $html) {
		   mydie("duplicate reference [$1] in $html and $REFMAP->{$1}.");
	      }
              $REFMAP->{$1}=$html;
	  }
       }
    }
    close H;
  }
  open I,">$index" or mydie("cannot write $index: $!");
  map {print I "$_ $REFMAP->{$_}\n"} (keys %$REFMAP);
  close I;
#  print Dumper(\$REFMAP);
}

sub mailtopeter {
  my $room = shift;
  my $EMAIL .= "From: RoomTWiki\n";
  $EMAIL .= "To: Peter Marquardt <marquardt_p\@molgen.mpg.de>\n";
  $EMAIL .= "Subject: TWikiRoom $room not found\n\n";
  $EMAIL .= "Not found: [$room]\n";
  my $hostname=getdns($ENV{REMOTE_ADDR});
  $ENV{REMOTE_ADDR}  and $EMAIL .= "   FROM: $ENV{REMOTE_ADDR} $hostname\n";
  $ENV{HTTP_REFERER} and $EMAIL .= "REFERER: $ENV{HTTP_REFERER}\n";
  $EMAIL .= "\n\n";
  $EMAIL .= Dumper(\%ENV);
  mysend_email($EMAIL);
}

sub getdns {
  my $n=(gethostbyaddr(pack("C4",split /\./,shift), 2))||'';
  $n =~ s/\.molgen\.mpg\.de//g;
  return $n;
}

sub mysend_email {
    my ($msg) = @_;
    my ($pid);
    local (*PIPE);
    my $SENDMAIL="/usr/sbin/sendmail";

    defined ($pid=open PIPE,"|-") or die "fork failed: $!\n";
    unless ($pid) {
        exec "$SENDMAIL -t";
    }
    print PIPE $msg;
    close PIPE or die "$SENDMAIL failed (sts=$?)\n";
}