Uploadscript funktioniert seit umstieg nicht mehr

Alles, was Perl betrifft, kann hier besprochen werden.

Uploadscript funktioniert seit umstieg nicht mehr

Postby Stegge » 18. September 2003 06:48

Hallo zusammen!

Ich habe ein Problem mit einem Perl Upload Script unter Xampp. Unter Windows und IIS hat es ohne Problem funktioniert. Nun wird zwar der Upload ausgeführt, aber die Datei wird in den falschen Ordner kopiert.
Die Datei soll unter http://SERVERNAME/DATEINAME abrufbar sein.
Dazu müsste sie meines wissens nach im Ordner C:\XAMPP\XAMPP\htdocs liegen.
Beim Upload wird die Datei aber nach c:\XAMPP\XAMPP kopiert.
Könnt ihr mir bitte weiterhelfen, und mir sagen wie ich den folgenden Quellcode ändern muss, damit die Dateien an den gewünschten Ort kopiert werden. Schon mal Vielen Dank!!!

#!/usr/bin/perl -w

use strict;
use CGI; # Modul fuer CGI-Programme
use DBI;
use File::Basename;
use CGI::Cookie;
my $cgi = new CGI; # neues Objekt erstellen

###übernahmederdaten:#########################################################
my $lehrjahr = $cgi->param("lehrjahr");
my $stufe = $cgi->param("stufe");
my $beschreibung = $cgi->param("beschreibung");
my $links = $cgi->param("dateiname");

###deklaration################################################################
my $dbh;
my $sth;
my $database = "elearning";
my $username = "root";
my $password = "";
my $host = "wmuc136039";
my $port = "3306";
my $data_source = "DBI:mysql:$database:$host:$port";
my $ausgabe;
my $sql;
my $Berufsbild;
my @row;
my $dir = './././htdocs';

###upload:####################################################################
print $cgi->header(-type => 'text/html');

# die datei-daten holen
my $file = $cgi->param("upload");

# Ermittelung des Lokalen Dateinamen mit fileparse (Modul File::Basename)
#fileparse_set_fstype("MSDOS"); # empfohlen
#my($remote_filename, $local_path) = fileparse $filename;


# dateinamen erstellen und die datei auf dem server speichern
my $fname = $links;
#my $fname = $remote_filename;

#open (STORAGE, ">$dir/$fname")
#or die "Error: Fehler beim Hochladen der Datei $fname.";
open DAT,'>'.$fname or die 'Error processing file: ',$!;
#open (OUTFILE,">$dir/$fname") || err("Fehler bei Hochladen","$dir/$fname");
#binmode OUTFILE;




# Dateien in den Binaer-Modus schalten
binmode $file;
binmode DAT;

my $data;
while(read $file,$data,1024) {
print DAT $data;
}
close DAT;


###connect:###################################################################
$dbh = DBI->connect( $data_source, $username, $password) ||
die "Keine Verbindung zur Datenbank möglich: $DBI::errstr\n";

my $altCookie = $cgi->cookie(-name=>'sessionid');

###Datenbank auslesen:############################Berufsbild##################

my $SQL = "SELECT Berufsbild From user Where Q_nummer = \"$altCookie\"";
# Prepare SQL Execution
$sth = $dbh->prepare($SQL);
# Do SQL Execution
$sth->execute();
# Get Return
while (@row = $sth->fetchrow_array)
{
$Berufsbild = $row[0];
}
###schreiben der stufe,beschreibung...######################################################

$sql= "Insert Into lerninhalte Values (\"$links\", \"$beschreibung\", \"$Berufsbild\", \"$lehrjahr\", \"$stufe\")";

###schreiben##################################################################
$sth = $dbh->prepare($sql) || die $dbh->errstr;
$sth->execute() || die $dbh->errstr;



###ausgabe:###################################################################
print $cgi->header;
###css definieren#############################################################
print<<style;
<style>
<!--
body { color: #000000; font-family: Arial, Helvetica, Geneva, Swiss, SunSans-Regular; font-size: 14px; text-decoration: none; }
.ft { color: #000000; font-family: Arial, Helvetica, Geneva, Swiss, SunSans-Regular; font-size: 14px; text-decoration: none; }
.hl1 { color: #000000; font-family: Arial, Helvetica, Geneva, Swiss, SunSans-Regular; font-size: 19px; line-height: 21px; text-decoration: none; font-weight:bold; }
.hl2 { color: #666666; font-family: Arial, Helvetica, Geneva, Swiss, SunSans-Regular; font-size: 19px; line-height: 21px; text-decoration: none; font-weight:bold; }
.hl3 { color: #999999; font-family: Arial, Helvetica, Geneva, Swiss, SunSans-Regular; font-size: 19px; line-height: 21px; text-decoration: none; font-weight:bold; }
.foot { font-family:Arial, Helvetica, Geneva; font-size:11px; line-height:11px; }
-->
</style>
style

###Inhalt der Seite############################################################
print "<table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" width=\"600\">";
print " <tr>";
print " <th height=\"19\" width=\"600\">";

print " </th></tr>";
print " <tr>";
print " <td height=\"94\" width=\"480\" valign=\"top\">";
print " <font class=\"hl1\"><b>trainLink</b></font><br>";
print " <font class=\"hl2\"><b>Upload</b></font>";
print " </td>";
print " <td width=\"120\" valign=\"top\"><img alt=\"TEST Group\" border=0 height=84 src=\"http://wmuc136039/trainLink/Startseite_einloggen/img/p_b2.gif\" width=70></td></tr>";
print " </td></tr></table>";
print " <table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" >";

print " Die Datei $file wurde erfolgreich hochgeladen und gespeichert.";

print "</table><table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" width=\"600\">";
print " <tr>";
print " <td height=\"20\" width=\"600\" valign=\"left\" class=\"ft\">";
print " <br><br><img src=\"http://wmuc136039/trainLink/Startseite_einloggen/img/Leiste.jpg\" width=\"480\" height=\"40\" border=\"0\" alt=\"\">";
print " <td></tr>";
print " </table>";




###statuszeile und ende der seite##############################################
print<<status;

<p align="left"><font size="-2" face="Arial, Helvetica" class="foot">
[Stand: 29. Jan. 2003
| <a href="mailto:Timm.Broenner\@test.de">Kontakt</a>
| <a href="../index.htm" onmouseout="window.status=''" onmouseover="window.status='Home Projekt'; return true;" target=_top>trainLink</a>
| <a href="http://www.muc/" target="_top" onmouseover="window.status='TEST Group Intranet'; return true;" onmouseout="window.status=''">TEST Group Intranet</a> | © TEST AG]</font><br></p>

status
print $cgi->end_html;
Stegge
 
Posts: 1
Joined: 18. September 2003 06:06

Return to Perl

Who is online

Users browsing this forum: No registered users and 41 guests