Forum Webscript.Ru

Программирование => Perl => Тема начата: movs от 25 Марта 2004, 17:05:53

Название: загрузка файлов на сервер
Отправлено: movs от 25 Марта 2004, 17:05:53

Есть такой скриптик. Локально на IIS под виндой все работает, а вот при загрузке к провайдеру на может открыть локальный файл (затыкается на строке:
open ( SRC, $imagename) || die print("Cannot Open File $imagename");
Где я наглючил?


sub upload
{
   ($imagename)=@_;
   $imagename=~m/^.*(\\\\|\\/)(.*)/;
   $imagename =~tr/бвчздецъйклмнопртуфхжигюыэящшьасБВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС?/АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюяё/;
   my $name = $2;
   open ( SRC, $imagename) || die print("Cannot Open File $imagename");;
   binmode (SRC) || die print("Cannot Bin Open File");
   @imgdata=;                                                            
        close(SRC);
        open(DST,">$name") || die print("Cannot BinOpen File");
   binmode(DST);
        foreach $istring (@imgdata)
   {
           print DST $istring;
   }
        close(DST);
   print" uploaded: $name
";
}

Название: загрузка файлов на сервер
Отправлено: NeoNox от 25 Марта 2004, 17:32:29

Это хорошо что ты имена файлов в кирилице задаеш.
Только неплохо было бы узнать как понимает это сервер.
самое быстрое решение - имена файлов в латинице.
Иначе копай в сторону locale

Название: загрузка файлов на сервер
Отправлено: movs от 25 Марта 2004, 17:51:45

На самом деле это для того, чтобы можно было загружать файлы из папки Мои Документы. Я пробовал чисто латинские файлы, строчку с перикодировкой вообще  убирал - та же фигня. А что может быть с локалью?
 :(

Название: загрузка файлов на сервер
Отправлено: NeoNox от 25 Марта 2004, 18:11:05

замени
 open ( SRC, $imagename) || die print("Cannot Open File $imagename");;
на
 open ( SRC, $imagename) || die print("Cannot Open File $imagename: $!");

Название: загрузка файлов на сервер
Отправлено: movs от 26 Марта 2004, 11:20:49

No such file or directory.

Еще одна тема. если написать
open ( SRC, ">$imagename")
то оно создает пустой файл на сервере в текущем каталоге с именем "С:\\mydir\\myfile.jpg"

Название: загрузка файлов на сервер
Отправлено: movs от 26 Марта 2004, 15:53:04

И вообще на chdir "c:" оно говорит No such file or directory

Название: загрузка файлов на сервер
Отправлено: NeoNox от 26 Марта 2004, 20:23:55

chdir "c:/"
скрипт покажи

Название: загрузка файлов на сервер
Отправлено: movs от 29 Марта 2004, 10:20:59

chdir c:/
No such file or directory

Текст скрипта: (это типа новости для сайта, см ветку todo=doadd)



#!/usr/bin/perl -Tw

$URL_to_script="/admin/news.cgi";
$myheader="header.html";
$myfooter="footer.html";
$newsfile="../news1";
$imagedir="../newsimg";

use CGI \':standard\';

&input_all;
print "Content-type: text/html\\nPragma: no-cache\\n\\n";

if( $todo eq "login"){
&printheader;

print <

 
   
 

Add news         Edit news         Delete news

EOF
&printfooter;
}

elsif($todo eq "add"){      #Add new galery
   &printheader;
   print <

Add news

 
   
 
 
   
   
 
 
   
   
 
 
   
   
 

   
   
 

Subject:
Short Description
Long Description
Select image

EOF
   &menu;                                                              
   &printfooter;
   }

   elsif( $todo eq "doadd"){        #Submit
      &printheader;
      $/="";
      open(DAT,"<$newsfile");
      @data=;
      close DAT;
      if( @data eq "" ){
         $i = 0;
      }
      else
      {
      ($i,$ii)=(split /\\|/, $data[0]);
      ++$i;
      }
      if($image ne ""){
         chdir("$imagedir");
         &upload($image);
         $image=~m/^.*(\\\\|\\/)(.*)/;
         $image = $2;
         chdir("..");
      }

      $short = html2text($short);
      $long = html2text($long);
      @TI = localtime(time);
      $date = @TI[3]."." .(@TI[4]+1).".".(@TI[5]+1900);
      &write("$newsfile", "$i\\|$subject\\|$date\\|$short\\|$long\\|$image\\n");
      &write(">$newsfile",@data);
      print "Done.";
      &menu;
      &printfooter;
   }

   elsif( $todo eq "del"){        #Remove galery
      &printheader;
print <      

      
EOF
      open(DAT,"<$newsfile") || die print "Cann\'t open file";
      foreach(){
         ($id,$subj)=split(/\\|/);
         print "$subj
";
      }
      close( DAT);
print <      
      
EOF
      &menu;
      &printfooter;
   }

   elsif( $todo eq "dodel"){        #Remove galery
   &printheader;
   $/="\\n";
   open(DAT,"<$newsfile") || die print "Cann\'t open file";
   foreach (){
      ($id,$subj,$date,$short,$long,$image)=split(/\\|/);
      if($i ne $id){
         push @data,$_;
      }
      else{
         $imagetodel=chomp($image);
      }
   }
   close( DAT);
        open(DAT,">$newsfile");
        print DAT "@data";
        close(DAT);
   if( $imagetodel ne ""){
      chdir("$imagedir");
      unlink "$imagetodel" || warn "File $imagetodel not deleted. ";
      chdir("..");
   }
   
   
   print "Done.";
   &menu;
   &printfooter;

   }

   elsif( $todo eq "edit"){        #Edit galery
      &printheader;
print <      

      
EOF
      open(DAT,"<$newsfile") || die print "Cann\'t open file";
      foreach(){
         ($id,$subj)=split(/\\|/);
         $id=$id+0;
         print "$subj
";
      }
      close( DAT);
print <      
      
EOF
      &menu;
      &printfooter;
   }

   elsif( $todo eq "editthis"){        #Remove galery
   &printheader;
   $/="\\n";
   open(DAT,"<$newsfile") || die print "Cann\'t open file";
   @data=;
   close DAT;
   foreach (@data){
      ($id,$subj,$date,$short,$long,$image)=split(/\\|/);
      $id=$id+0;
      if($i eq $id){
   print <

Edit news

 
   
 
 
   
   
 
 
   
   
 
 
   
   
   
 
 
   
   
 
 
   
   
 
 
   
   
 

Subject:
Short Description	$short
Long Description	$long
Old Image:	$image
Select new image:

EOF
                }
   }
   &menu;                                                              
   &printfooter;
   }


   elsif( $todo eq "doedit"){        #Remove galery
   &printheader;
   $/="\\n";
   open(DAT,"<$newsfile") || die print "Cann\'t open file";
   foreach (){
      ($id,$subj)=split(/\\|/);
      $id=$id+0;
      if($i < $id){
         push @data1,$_;
      }
      elsif($i > $id){
         push @data2,$_;
      }
      else{


      }
   }
   close( DAT);
        open(DAT,">$newsfile");
        print DAT "@data1";
   if ($oldimage ne $image){
      chdir("$imagedir");
      unlink ("$oldimage");
      &upload("$image");
      $image=~m/^.*(\\\\|\\/)(.*)/;
      $image = $2;
      chdir("..");
   }
   print DAT "$i\\|$subject\\|$date\\|$short\\|$long\\|$image";
   print DAT "@data2";
        close(DAT);
   
   
   print "Done.";
   &menu;
   &printfooter;

   }

exit;

sub write
{
    ($writeto_file,@write)=@_;
    flock(DAT, 2);
        open(DAT,">$writeto_file");
        print DAT "@write";
        close(DAT);
    flock(DAT, 8);
}


sub input_all
{
       $date=param(\'date\');
   $todo=param(\'todo\');
   $subject=param(\'subject\');
   $long=param(\'long\');
   $short=param(\'short\');
   $i=param(\'i\');
   $image=param(\'image\');
   $oldimage=param(\'oldimage\');
}

sub menu{
print <

EOF
}

sub html2text
{
    my ($html)=@_;
    $html=~ s/\\r\\n/
/g;
#    $html=~ s/
/\\n/g;
    $html=~ s/\\"/\\"\\;/g;
   
    return $html;
}

sub text2html
{
    my ($html)=@_;
    $html=~ s/\\"\\;/\\"/g;
    return $html;
}

# HEADER & FOOTER

sub printheader{
   open(R, "$myheader");
   @lines = ;
   close(R);
   foreach $line (@lines){
      $header .= $line;
   };
   print $header;
}
sub printfooter{
   open(R, "$myfooter");
   @lines = ;
   close(R);
   foreach $line (@lines){
      $footer .= $line;
   };
   print $footer;
}
sub upload
{
   ($imagename)=@_;
   $imagename=~m/^.*(\\\\|\\/)(.*)/;
   $imagename =~tr/бвчздецъйклмнопртуфхжигюыэящшьасБВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС?/АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюяё/;
   my $name = $2;

   open (DST,">$name") || die print "Cannt open dst file: $!";
   binmode(DST);
   flock(DST, 2);
   chdir ("C:/") || die print "cannt chdir $!";
        while ($bytesread=read($imagename,$buffer,1024)) {
            print DST $buffer;
        }
   close(DST);
   close $imagename;

   print" uploaded: $name
";
}

Название: загрузка файлов на сервер
Отправлено: NeoNox от 29 Марта 2004, 11:36:19

1. используй use strict; в скрипте
2. в блоке
if($image ne ""){
chdir("$imagedir");
&upload($image);
$image=~m/^.*(\\\\|\\/)(.*)/;
$image = $2;
chdir("..");
}
что делает
$image=~m/^.*(\\\\|\\/)(.*)/;
$image = $2;
?
может это нужно было сделать перед вызовом upload($image) ?
3. для определения текущего местоположения в каталогах используй модуль:
use Cwd;
print cwd;
4. расставь метки и делай printна каждый чих программы.
5. chdir \'c:/\'
No such file or directory
Надеюсь это у тебя в виндовс?

Microsoft Windows XP [Version 5.1.2600]
(C) Copyright 1985-2001 Microsoft Corp.

C:\\Documents and Settings>perl -de0
Default die handler restored.

Loading DB routines from perl5db.pl version 1.07
Editor support available.

Enter h or `h h\' for help, or `perldoc perldebug\' for more help.

main::(-e:1):   0
  DB<1> use Cwd

  DB<2> print cwd
C:/Documents and Settings
  DB<3>  chdir \'c:/\'

  DB<4> print cwd
c:/

Название: загрузка файлов на сервер
Отправлено: movs от 31 Марта 2004, 10:33:13

Забавно. Так не работает:
open ( SRC, $imagename) || die print("Cannot Open File $imagename");;
binmode (SRC) || die print("Cannot Bin Open File");
@imgdata=;
close(SRC);
open(DST,">$name") || die print("Cannot Open File $!");
binmode(DST);
foreach $istring (@imgdata)
{
print DST $istring;
}
close(DST);


Так тоже не работает:
while ($bytesread=read($imagename,$buffer,1024)) {
print DST $buffer;
}

А вот так почему-то работает
open (DST,">$name") || die print "Cannt open dst file: $!";
binmode(DST) || die print "cannt binmode DST";
print DST while (<$imagename>);
close(DST);

Теперь мне интересно ПОЧЕМУ? :)

PS. не print cwd
а вот так:
$path=getcwd();
print path;
Все равно помогло, спасибо.

Название: загрузка файлов на сервер
Отправлено: NeoNox от 31 Марта 2004, 11:18:55

Цитировать

movs:
Теперь мне интересно ПОЧЕМУ?

А perldoc не пробовал почитать?
perldoc -f open

Цитировать

movs:
PS. не print cwd а вот так:

... и еще по Cwd:
perldoc Cwd