<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
use strict;
use warnings;

# Verzeichnisse ermitteln
BEGIN 
{ push @INC,"lib";
  #push @INC,"/var/www/dom/doom/htm/perl/lib";
}

use query;
use sprite;
use lumps;
use lumps::const;
use dmmus;

select(STDERR); $|=1; select(STDOUT); $|=1;  # Autoflush

sub getLumpError()
{ print "Content-type: text/html\n\n";
  print "&lt;h3&gt;getlump.pl&lt;/h3&gt;\n";
  print "&lt;h4&gt;Benutzung: getlump.pl?zip=Archiv&amp;wad=Wad-Datei&amp;nam=Lump-Name&lt;/h4&gt;\n";
  print "&lt;b&gt;zip&lt;/b&gt; ist nur erforderlich, wenn die Wad-Datei in einem Archiv ist&lt;br /&gt;\n";
  print "&lt;b&gt;wad&lt;/b&gt; kann entweder eine Wad-Datei (z.B. blood.wad) oder eine der folgenden Bezeichnungen: &amp;lt;doom, doom2, plutonia, tnt&amp;gt; sein&lt;br /&gt;\n";
  print "&lt;b&gt;nam&lt;/b&gt; muss ein vollständiger Lump-Name sein (z.B. TROOA1)&lt;br /&gt;\n";
  print "Beispiele:&lt;br /&gt;\n";
  print "getlump.pl?wad=doom2&amp;nam=DSRLAUNC&lt;br /&gt;\n";
  print "getlump.pl?zip=../files/pwads/island2.zip&amp;wad=island2.WAD&amp;nam=TRE7A0&lt;br /&gt;\n";
  print "getlump.pl?zip=../files/pwads/eternall.zip&amp;wad=eternall.wad&amp;nam=D_OPENIN&lt;br /&gt;\n";
  print "&lt;br /&gt;\n";
  print "Einige Lumps, z.B. PLAYPAL, PNAMES und andere können nicht ausgegeben werden, da diese Funktion diese Binär-Formate nicht anzeigen kann.&lt;/br &gt;\n";
  print "&lt;br /&gt;&amp;copy; 2009 Dieter Heinrich&lt;/br /&gt;\n";
  exit(1);
}

# $f: "F", "S", oder "P"
sub checkFSP($$$)
{ my ($f,$n,$wdt)=@_;
  my ($tp,$tp0,$tpe,)=("","");
  foreach my $k (keys %$$wdt)
  { if ($k=~/^($f.?)_START$/)
    { $tp0=$1; if ($n&gt;$$wdt-&gt;{$k}-&gt;{idx}) { $tp=$tp0; } 
    } else
    { if ($tp ne "") { $tpe=$tp."_END"; if ($k=~/^$tpe$/) { return $tp; } }
    }
  }
  return "";
}

my %qParam=();  my %pParam=();
my ($pal,$zip,$wad,$nam,$mus,$mid,$wadbuf,$typ)=("","","","","","","","");
my ($lok,$fp,$zp,$hexen,$chk,$namn)=(0,0,0,0,0,-1);
my $iwdtab={};
my @lokwad=('doom','doom2','plutonia','tnt');
if (open(PAL,"&lt;","../css/lmp/playpal.lmp"))
{ binmode(PAL);  read(PAL,$pal,-s PAL);
  close PAL;
}
getQueryFields(\%qParam);
getPostFields (\%pParam);
if (exists($qParam{"zip"})) { $zip=$qParam{"zip"}; }
if (exists($qParam{"wad"})) { $wad=$qParam{"wad"}; }
if (exists($qParam{"nam"})) { $nam=$qParam{"nam"}; }
if ($wad eq "" || $nam eq "") { getLumpError(); }
if ($zip eq "") { foreach(@lokwad) { if ($wad eq $_) { $lok=1; } } }
if (!$wad=~/[^.]+$/ &amp;&amp; $lok==0) { $wad.=".wad"; }
if ($zip eq "")
{ if (-f $wad &amp;&amp; !$lok)
  { open(WAD,"&lt;",$wad) || getLumpError(); $fp=*WAD;
  }
}
if ($fp || $lok || ($zip ne "" &amp;&amp; -f $zip)) { } else { getLumpError(); }
if ($zip ne "" || $fp)
{ getIwdTab($fp,$zip,$wad,\$iwdtab,\$pal,\$hexen);
  if (exists($iwdtab-&gt;{'PLAYPAL'}))
  { getWadLump($fp,$zip,$wad,\$pal,"",$nam,$iwdtab-&gt;{'PLAYPAL'}-&gt;{'ptr'},$iwdtab-&gt;{'PLAYPAL'}-&gt;{'len'}); }
  if (!exists($iwdtab-&gt;{$nam})) { if ($fp!=0) { close($fp); } getLumpError(); }
  getWadLump($fp,$zip,$wad,\$wadbuf,"",$nam,$iwdtab-&gt;{$nam}-&gt;{'ptr'},$iwdtab-&gt;{$nam}-&gt;{'len'});
  foreach my $k (keys %$iwdtab) { if ($k eq $nam) { $namn=$iwdtab-&gt;{$k}-&gt;{idx}; } }
  if ($namn&gt;=0) 
  { if ($typ eq "") { $typ=checkFSP("F",$namn,\$iwdtab); }
    if ($typ eq "") { $typ=checkFSP("S",$namn,\$iwdtab); }
    if ($typ eq "") { $typ=checkFSP("P",$namn,\$iwdtab); }
  }
} else { getWadLump($fp,$zip,$wad,\$wadbuf,"",$nam,0,0); }
$chk=chkLumpTyp($typ,$nam,\$wadbuf);
if ($chk==TYP_TXT || $chk==TYP_SCR)
{ print "Content-Type: text/plain\n\n";
  print $wadbuf;
}
if ($chk==TYP_GIF)
{ print "Content-Type: image/gif\n\n";
  print $wadbuf;
}
if ($chk==TYP_PNG)
{ print "Content-Type: image/png\n\n";
  print $wadbuf;
}
if ($chk==TYP_JPG)
{ print "Content-Type: image/jpeg\n\n";
  print $wadbuf;
}
if ($chk==TYP_GFX)  { displaySprite(\$wadbuf,\$pal,0,0); }
if ($chk==TYP_FLT)  { displayFlat(\$wadbuf,\$pal,0,0); }
if ($chk==TYP_MUS || $chk==TYP_MID) 
{ if ($chk==TYP_MUS) { musToMidi(\$wadbuf,\$mid); } else { $mid=$wadbuf; }
  #print "Content-Type: application/midi\n";
  print "Content-Type: audio/midi\n";
  #print "Accept-Ranges: Bytes\n";
  print "Content-Length: ".length($mid)."\n";
  #print "Content-Disposition: attachment; filename=\"".$nam.".mid\"\n";
  print "Content-Disposition: inline; filename=\"".$nam.".mid\"\n";
}
if ($chk==TYP_MP3)
{ $mid=$wadbuf;
  print "Content-Type: audio/mpeg\n";
  print "Content-Length: ".length($mid)."\n";
  print "Content-Disposition: inline; filename=\"".$nam.".mp3\"\n";
}
if ($chk==TYP_SWV || $chk==TYP_WAV)
{ if ($chk==TYP_WAV) { $mid=$wadbuf; }
  else 
  { my ($mg,$sps,$nos)=unpack('vvv',$wadbuf);
    $mid="RIFF".pack('V',$nos+36+($nos%2))."WAVE";
    $mid.="fmt ".pack('VvvVVvv',16,1,1,$sps,$sps,1,8);
    $mid.="data".pack('V',$nos);
    $mid.=substr($wadbuf,8);
  }
  print "Content-Type: audio/wav\n";
  print "Content-Length: ".length($mid)."\n";
  print "Content-Disposition: inline; filename=\"".$nam.".wav\"\n";
}
if ($chk==TYP_MUS || $chk==TYP_MID || $chk==TYP_MP3 || $chk==TYP_SWV || $chk==TYP_WAV )
{ print "Cache-Control: private, max-age=0, must-revalidate\n";
  #print "Cache-Control: must-revalidate, post-check=0, pre-check=0\n";
  print "Pragma: public\n";
  print "\n";
  print $mid;
} else
{ if ($fp!=0) { close($fp); $fp=0; }
  if ($chk!=TYP_TXT &amp;&amp; $chk!=TYP_GIF &amp;&amp; $chk!=TYP_PNG &amp;&amp; $chk!=TYP_GFX &amp;&amp; $chk!=TYP_FLT) { getLumpError(); }
}

if ($fp!=0) { close($fp); }

__END__

</pre></body></html>