Thread Von Perl 5.8.7 -> 5.8.8 upload funktioniert nicht mehr (38 answers)
Opened by Tom at 2007-12-06 02:28

Tom
 2007-12-07 00:08
#103534 #103534
User since
2003-09-20
470 Artikel
BenutzerIn
[Homepage] [default_avatar]
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
#!/usr/bin/perl -w

use CGI::Carp "fatalsToBrowser";
use CGI qw(:all);
use warnings;
use DBI;
use lib './module';
use HTML::Template;
use FindBin;
use File::Type::WebImages 'mime_type';
use strict;

use vars qw($action $redirect $root_path $prog_lib %lang);

&get_path;

$action = param('action');
my $cgi = CGI->new();
my %params = $cgi->Vars();
#my $path = $root_path . '/yambe/bilder/userpic';
my $path = 'd:/Projekte/YAMBE/Development/2.x/yambe/bilder/userpic';
my $filehandle = $cgi->upload('user_pic');
my $filename = $params{'user_pic'};
#$filename = (split(/[\\\/]/,$filename))[-1];
#$filename =~ s/[^A-Za-z0-9_\.\-]//g;
#$filename =~ s/\\/\//g;

my %Mode = (
    ''                           =>    \&form,
    'upload'                  =>    \&upload_datei,
    );
    
    if($Mode{$action})
     {
         $Mode{$action}->();
     }
     else
     {
       $redirect =  $root_path . "/cgi-bin/yambe/register.cgi";
       my $q = new CGI;
       print $q->redirect($redirect);
     };
     
sub form
{    
my $template = HTML::Template->new(filename => 'upload.tmpl',
                                 path => ["$prog_lib/templates/standard"]);


#Bindet den Header ein.
&header(0);
$template->param(ROOT_PATH => $root_path);
print $template->output;
#Bindet den Footer ein.
&footer(0);
exit;
}

sub upload_datei
{

#Bindet den Header ein.
&header(0);
upload_file($filename,$filehandle,$path);

my $uploaded_file = $path . "\\" . $filename;
                                                           
my $check_file = mime_type($uploaded_file);

if ($check_file eq undef)
{
        ...
}       
else
{
        ...
}       
#Bindet den Footer ein.
&footer(0);
exit;
}


sub upload_file
{
my ($filename,$filehandle,$path) = @_;
       
my $target = $path.'/'.$filename;
if(-e $target){
print "Zieldatei existiert schon!";
exit(0);
}
else{
binmode $filehandle;
open(TARGET,">$target") or die $!;
binmode TARGET;

my ($buffer);
while(read $filehandle,$buffer,1024){
print TARGET $buffer;
}
close TARGET;
print "<h2>Ihre Datei wurde unter $target gespeichert</h2>";
}
}
Computerprobleme??? -> http://www.weber-computerhilfe.de

Fordere keine Anerkennung!
Zeige was und man wird Dich kennen

View full thread Von Perl 5.8.7 -> 5.8.8 upload funktioniert nicht mehr