#!/usr/bin/perl
use CGI;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use File::Spec;

# strict und warnings vereinfachen die Fehlersuche:
use strict;
use warnings;

my $load_win_shortcut;
my $load_win_symlink;
sub BEGIN
{
  # unter Windows symlink laden.
  # unixodie System können das direkt...
  if($^O =~/win/i)
  {
    # versuchen zu laden
    $load_win_shortcut=0;
    eval("Win32::Shortcut");
    $load_win_shortcut=1 unless($@);

    # Windows Symlinks als "fallback"
    $load_win_symlink=0;
    eval("use Win32::Symlink");
    $load_win_symlink=1 unless($@);
  }
  # Win23::Symlink überschreibt den Befehl "symlink"
  # das Modul sollte installiert sein.
}

# der basispfad in dem nach der PDF-Datei geschaut wird
# hier in Windows sowas wie "C:","ARCHIV" eintragen.
#my @path=('C:','ARCHIV');
my @pfad=('','ARCHIV');
# der Dateiname, der Gesucht wird
my $filename='asd.pdf';
# Dateiname der auf der Seite Präsentiert wird
my $webfilename='.%s.pdf';

my $cgi=CGI->new();
print $cgi->header();
warningsToBrowser(1);

my $gms_oid=$cgi->param("o");
if ($gms_oid)
{
  # name in Hexwerte wandeln und alle 2 stellen splitten.
  push(@pfad, split(/(?=(?:\d\d)+$)/,sprintf("%010X",$gms_oid)));

  # Sysmenunabhängige Pfadangabe in die Systemabhängige wandeln
  my $file=File::Spec->catfile( @pfad, $filename );
  # Existiert die Datei an dem Ort?
  if(-e $file)
  {
    # Webnahme erzeugen.
    my $webfile=sprintf($webfilename,$gms_oid);

    # symlink erzugen wenn er nicht schon existiert
    # funktioniert unter windows nur auf "ntfs"
    my $error_msg;
    unless (-e $webfile)
    {
      if(defined($load_win_shortcut) && $load_win_shortcut==1)
      {
        #Windows shortcuts
        # funktioniert auch über "NetzwerkLaufwerke"
        my $lnk = new Win32::Shortcut();
        $lnk->Path($file);
        $error_msg=$lnk->Save($webfile);
        $error_msg="Konnte $webfile.lnk nicht erstellen ($!)" unless($error_msg);
      }
      elsif(defined($load_win_symlink) && $load_win_symlink==1)
      {
        # alternativ symlink versuchen
        # eval erzeugt hier eine neue Interpereterinstanz
        # das ist nötig, da es zu einem Programmabbruch kommt,
        # wenn symlinks nicht unterstützt sind.
        $error_msg=eval{ symlink($file, $webfile) };
        if($@)
        {
          # Symlinks funktionieren generell nicht
          $error_msg="Smlinks funktionieren auf diesem System nicht!" ;
        }
        elsif(!$error_msg)
        {
          # das erstellen des Symlinks hat nicht funktioniert
          $error_msg="Konnte Symlink $webfile nicht erstellen ($!)";
        }
      }
    }

    if(-e $webfile)
    {
      # als inline-PDF ausgeben:
      print_html("<embed src='$webfile' width='100%' height='776px'>");
    }
    else
    {
      # aus irgend einem Grund konnte keine verknüpfung iregendeiner Art erstellt werden
      print_html($cgi->h1("Link Konnte nicht etzeugt werden!").$cgi->p($error_msg));
    }
  }
  else
  {
    # fehlermeldung wenn die PDF-Datei nicht gefunden wurde.
    print_html($cgi->h1("\"$gms_oid\" existiert nicht"));
  }
}
else
{
  # fehlermeldung wenn kein Parameter "o" angeben wurde.
  print_html($cgi->h1("Parameter \"o\" nicht angeben"));
}

########################################################################
# HTML-Ausgabe
sub print_html
{
  my $inline=shift;
  print $cgi->start_html(-title=>"BLUB", -bgcolor=>"#AAAAAA", -style=>{"src"=>'licis.css'}, -script=>{-language=>'JavaScript', -src=>'gms.js'});
  print $inline;
  print $cgi->end_html();
}