Follow along with the video below to see how to install our site as a web app on your home screen.
Примечание: This feature may not be available in some browsers.
#!/usr/bin/perl
#
# upload.pl
#
# Usage upload.pl <source directory> <ftp site> <user name> <password>
# <ftp directory>
#
#
# Script for generating the ftp commands to logicalshift.org.uk
# Copyright (C) 1999 Andrew Hunter (andrew@logicalshift.org.uk)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#
# Contributor(s): No one yet.
#
use Net::FTP;
use IO::Handle;
use DirHandle;
use File::stat;
use POSIX;
use Time::gmtime;
use Time::Local;
$DEBUG=0;
# Constants & tables
%months = ( Jan => 0,
Feb => 1,
Mar => 2,
Apr => 3,
May => 4,
Jun => 5,
Jul => 6,
Aug => 7,
Sep => 8,
Oct => 9,
Nov => 10,
Dec => 11 );
$now = gmtime();
$year = $now->year();
$sourcedir = $ARGV[0];
$ftpsite = $ARGV[1];
$username = $ARGV[2];
$password = $ARGV[3];
$ftpdir = $ARGV[4];
# Functions
# If your ftp server uses a different format from the one used here, try
# changing the regexp for recognising the format
sub getstructure
{
my ($ftpdir, $ftp, $realroot, $dispdot) = @_;
my $dirs = [ ];
my @dirlist = $ftp->dir("/$ftpdir");
if ($dispdot)
{
print STDERR "."; flush STDERR;
}
# We assume unix-style directory listings
my $x;
for ($x=0; $x<=$#dirlist; $x++)
{
if ($dirlist[$x] =~ /^((d|\-)((r|\-)(w|\-)(x|s|\-)){3,3}) *([0-9]+) *([^\s]+) *([^\s]+) *([0-9]+) *(... .. .....) *(.*)$/)
{
# $1 - permissions
# $7 - no. files
# $8 - user
# $9 - group
# $10 - size
# $11 - date
# $12 - filename
my $perm = $1;
my $files = $7;
my $user = $8;
my $group = $9;
my $size = $10;
my $adate = $11;
my $fname = $12;
my $date;
if ($adate =~ /^([A-Za-z]+) *([0-9]+) *([0-9]+):([0-9]+)$/)
{
$date = gmtime(timegm(0, $4, $3, $2, $months{$1}, $year));
}
elsif ($adate =~ /^([A-Za-z]+) *([0-9]+) *([0-9]+)$/)
{
$date = gmtime(timegm(0, 0, 0, $2, $months{$1}, $3));
}
else
{
die "Unrecognised date: $adate";
}
my $struct = [];
my $type = "FILE";
if ($fname !~ /^\.*$/)
{
if ($perm =~ /^d/)
{
$type = "DIR";
$struct = getstructure("$ftpdir/$fname", $ftp,
"$realroot/$fname");
}
my $entry = [ $type, "$realroot/$fname", $date, $size, $struct ];
$$dirs[$#$dirs+1] = $entry;
}
}
}
return $dirs;
}
sub printstructure
{
my ($dirs) = @_;
for (my $x=0; $x<=$#$dirs; $x++)
{
my ($out) = $$dirs[$x];
my ($type, $fname, $date, $size, $struct) = @$out;
print STDERR " $fname\n";
if ($type eq "DIR")
{
printstructure($struct);
}
}
}
sub getfilestructure
{
my ($dir, $realroot) = @_;
my $dirhandle = new DirHandle($dir);
my @dirlist = $dirhandle->read();
my $dirs = [];
print STDERR "."; flush STDERR;
for (my $x=0; $x<=$#dirlist; $x++)
{
if (($dirlist[$x] !~ /\~$/) &&
($dirlist[$x] !~ /^\#.*\#$/) &&
($dirlist[$x] !~ /^\.*$/))
{
# Find out about that file
my $stats = stat("$dir/$dirlist[$x]");
my $struct = [];
my $type = "FILE";
my $size = $stats->size;
my $date = gmtime($stats->mtime);
if (S_ISDIR($stats->mode))
{
$type = "DIR";
$struct = getfilestructure("$dir/$dirlist[$x]",
"$realroot/$dirlist[$x]");
}
my $entry = [ $type, "$realroot/$dirlist[$x]", $date, $size,
$struct ];
$$dirs[$#$dirs+1] = $entry;
}
}
return $dirs;
}
sub findfile
{
my ($filename, $files) = @_;
for (my $x=0; $x<=$#$files; $x++)
{
my $entries = $$files[$x];
if ($filename eq $$entries[1])
{
return $entries;
}
}
return 0;
}
sub ftprmdir
{
my ($dirname, $level) = @_;
my $dirstruct = getstructure($dirname, $ftp, $dirname);
for (my $x=0; $x<=$#$dirstruct; $x++)
{
my $entry = $$dirstruct[$x];
if ($$entry[0] eq "FILE")
{
$ftp->delete($$entry[1]);
}
else
{
ftprmdir($$entry[1], $level+2);
$ftp->rmdir($$entry[1]);
}
}
$ftp->rmdir($dirname);
}
sub clearout
{
my ($ftpfiles, $realfiles) = @_;
for (my $x=0; $x<=$#$ftpfiles; $x++)
{
my $entry = $$ftpfiles[$x];
my $realentry = findfile($$entry[1], $realfiles);
if (!$realentry)
{
print STDERR " Erasing $$entry[1]\n";
if ($$entry[0] eq "DIR")
{
ftprmdir("/$ftpdir/$$entry[1]", $$entry[4], 2);
}
else
{
$ftp->delete("/$ftpdir/$$entry[1]");
}
}
}
}
sub uploadnew
{
my ($ftpfiles, $realfiles) = @_;
for (my $x=0; $x<=$#$realfiles; $x++)
{
my $entry = $$realfiles[$x];
my $ftpentry = findfile($$entry[1], $ftpfiles);
if (!$ftpentry)
{
print STDERR " $$entry[1]\n";
if ($$entry[0] eq "DIR")
{
$ftp->mkdir("/$ftpdir/$$entry[1]");
uploadnew([], $$entry[4]);
}
else
{
my $foo = "$sourcedir/$$entry[1]";
my $bar = "/$ftpdir/$$entry[1]";
$ftp->put($foo, $bar);
}
}
else
{
if ($$entry[0] eq "DIR")
{
uploadnew($$ftpentry[4], $$entry[4]);
}
}
}
}
sub uploadchanged
{
my ($ftpfiles, $realfiles) = @_;
for (my $x=0; $x<=$#$realfiles; $x++)
{
my $entry = $$realfiles[$x];
my $ftpentry = findfile($$entry[1], $ftpfiles);
if ($ftpentry)
{
my $cur = $$entry[2];
my $old = $$ftpentry[2];
my $changed = 0;
if ($cur->year > $old->year)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon > $old->mon)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon == $old->mon &&
$cur->mday > $old->mday)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon == $old->mon &&
$cur->mday == $old->mday &&
$cur->hour > $old->hour)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon == $old->mon &&
$cur->mday == $old->mday &&
$cur->hour == $old->hour &&
$cur->min > $old->min)
{
$changed = 1;
}
if ($$entry[3] != $$ftpentry[3])
{
$changed = 1;
}
if ($$entry[0] eq "DIR")
{
uploadchanged($$ftpentry[4], $$entry[4]);
}
elsif ($changed)
{
my $foo = "$sourcedir/$$entry[1]";
my $bar = "/$ftpdir/$$entry[1]";
print STDERR " $$entry[1]\n";
$ftp->put("$sourcedir/$$entry[1]",
"/$ftpdir/$$entry[1]");
}
}
else
{
die "Whoops - programmer is a spoon!";
}
}
}
# Code starts here
print STDERR "upload.pl v0.1 written by Andrew Hunter\n";
print STDERR "Contacting ftp site...\n";
$ftp = Net::FTP->new("$ftpsite", Debug => 0);
# $ftp->hash(1, 1024);
$ftp->login("$username", "$password");
$ftp->cwd("/$ftpdir");
$ftp->binary();
print STDERR "Checking supported commands...";
flush STDERR;
if (!$ftp->supported("MKD"))
{
die "Does not support mkdir";
}
print STDERR "M";
flush STDERR;
if (!$ftp->supported("RMD"))
{
die "Does not support rmdir";
}
print STDERR "R";
flush STDERR;
if (!$ftp->supported("DELE"))
{
die "Does not support delete";
}
print STDERR "D";
flush STDERR;
if (!$ftp->supported("LIST"))
{
die "Does not support LIST";
}
print STDERR "L";
flush STDERR;
if (!$ftp->supported("STOR"))
{
die "Does not support STOR! This could make transfer difficult";
}
print STDERR "S";
flush STDERR;
print STDERR "...OK\n";
# Get the file structure from the ftp server
print STDERR "Reading the directory structure.";
flush STDERR;
my $dirs = getstructure($ftpdir, $ftp, "", 1);
print STDERR "\n";
if ($DEBUG)
{
printstructure($dirs);
}
print STDERR "Reading the actual structure.";
flush STDERR;
my $actualdirs = getfilestructure($sourcedir);
print STDERR "\n";
if ($DEBUG)
{
printstructure($actualdirs);
}
print STDERR "Clearing out the dead files and directories...\n";
clearout($dirs, $actualdirs);
print STDERR "Uploading new files and directories...\n";
uploadnew($dirs, $actualdirs);
print STDERR "Rereading the directory structure.";
flush STDERR;
my $dirs = getstructure($ftpdir, $ftp, "", 1);
print STDERR "\n";
print STDERR "Uploading changed files and directories...\n";
uploadchanged($dirs, $actualdirs);
perl upload.pl ./en майсаб.фрихост.com юзернейм пасс ./
Выскакивает ошибкаperl upload.pl ./papka IP login pass ./public_html/papka/
upload.pl v0.1 written by Andrew Hunter
Contacting ftp site...
Checking supported commands...MRDLS...OK
Reading the directory structure..
Reading the actual structure.Can't call method "read" on an undefined value at upload.pl line 162.
Попробывал заюзать этот перловый скрипт
Запускаю так
Выскакивает ошибка
Где я ошибся?
Скорее не она, а первая (./papka). Потому что:А ./public_html/papka/ физически существует?
sub getfilestructure
{
my ($dir, $realroot) = @_;
161: my $dirhandle = new DirHandle($dir);
162: my @dirlist = $dirhandle->read();
print STDERR "Reading the actual structure.";
flush STDERR;
my $actualdirs = getfilestructure($sourcedir);
print STDERR "\n";
$sourcedir = $ARGV[0];
perl upload.pl /var/www/data/www/site.com/papka IP login pass ./public_html/papka/