Модераторы: korob2001, ginnie
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Скрипт Резервного Копирования, Обсуждение, улучшение 
:(
    Опции темы
birdfree
Дата 28.3.2010, 17:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 12.12.2008

Репутация: 1
Всего: 1



Доброго времени суток!
Я тут решил начать писать в Perl скажу честно пишу всего около суток, так что пожалуйста не судите особо строго. Вот я решил выложить свое первое творение скрипт для резервного копирования папок с последующем сжатием их в zip архив. Скрипт запускается на флешке не которую нужно копировать файлы резервной копии. Вот прошу посмотреть, высказать свое мнение, внести улучшения. 

Код

############################################################
#Получение текущей даты
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime(time);
 
my $date = sprintf("%d.%02d.%02d_%02d-%02d-%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec);
print "Date is $date\n";
############################################################
use strict;
use warnings;
use locale;
use File::Basename;
use Cwd; # модуль для определения текущего рабочего каталога
############################################################
my ($startdir) = &cwd; # запомнить, откуда мы начали
print "$startdir\n";
##############################################################
#поиск файла-маркера для определения место резервного копирования

#############################################################
#Перемещение старых бэкапов в соответсвующие папки
#Удаляем все zip файлы из папки \backup_old_3
while(<$startdir/backup_old_3/*.zip>){
do{unlink $_ or die "cant remove: $!"} if m!.*\.zip$!;
print $_," Deleted!\n";

#Перемещаем все zip файлы из папки \backup_old_2 в \backup_old_3
foreach my $oldname(<$startdir/backup_old_2/*.zip>)
{
    my $newname = "$startdir/backup_old_3/" . basename($oldname);
    rename ($oldname, $newname);
}
#Перемещаем все zip файлы из папки \backup_old_1 в \backup_old_2
foreach my $oldname(<$startdir/backup_old_1/*.zip>)
{
    my $newname = "$startdir/backup_old_2/" . basename($oldname);
    rename ($oldname, $newname);
}
#Перемещаем все zip файлы из папки \backup в \backup_old_1
foreach my $oldname(<$startdir/backup/*.zip>)
{
    my $newname = "$startdir/backup_old_1/" . basename($oldname);
    rename ($oldname, $newname);
}
while(<$startdir/backup/*.zip>){
do{unlink $_ or die "cant remove: $!"} if m!.*\.zip$!;
print $_," Deleted!\n";
}
#############################################################

#Первый путь резервного копирования
my $directory_for_backup1 = 'c:/niao/test_data/'; 
#Первый Архив
my $backup_zip_file1 = "$startdir/backup/$date.first.zip"; 
#Второй путь резервного копирования
my $directory_for_backup2 = 'c:/niao/test_data_2/';
#Второй Архив
my $backup_zip_file2 = "$startdir/backup/$date.second.zip"; 
############################################################
$| = 1; # отключаем буферизацию ввода/вывода
############################################################
#Создание Первого Архива
print "\n!\n";
use Archive::Zip qw( :ERROR_CODES );
print "Directory backup...\n";
my $zip = Archive::Zip->new();
$zip->addTree($directory_for_backup1);
if ($zip->writeToFileNamed($backup_zip_file1) == AZ_OK ) {
    print "The Backup done.\n\n";
}
else {
    print "CAN'T WRITE BACKUP ZIP FILE ($backup_zip_file1): $!\n\n";
}
############################################################
#Создание Второго Архива
print "\n!\n";
use Archive::Zip qw( :ERROR_CODES );
print "Directory backup...\n";
#Вот тут исключаем типы файлы из архивирования: то есть при архивировании эти файлы будут пропущены
# Если заменить /\.bk$/ на /\.bk$/i, и в этом случае не будет чувствителен к регистр
$zip->addTree($directory_for_backup2, '', sub {!/\.rar$/i && !/\.bk$/i && !/name\.if$/i && !/\.ls/i && !/\.\$l$/i});
if ($zip->writeToFileNamed($backup_zip_file2) == AZ_OK ) {
    print "The Backup done.\n\n";
}
else {
    print "CAN'T WRITE BACKUP ZIP FILE ($backup_zip_file2): $!\n\n";
}
############################################################
 

как видите скрипт не много кривоват, по этому я и хочу узнать мнение общественности. И еще хотел бы спросить можно ли было как ни будь сделать отображение процесса архивирования, то есть сколько % упаковано то есть что то типа прогресс бара. Этот скрипт я писал с намеком на кроссплатформенность так что мое пожелание что бы он таким и оставался)) 

За помощь в создании этого творения я благодарю amg, за то что он рассказал как можно архивировать с исключением файлов по маске. Так же я благодарю Egik2 и Pfailed, за примеры по перемещению файлов. 

Это сообщение отредактировал(а) birdfree - 30.3.2010, 20:10
PM MAIL   Вверх
arto
Дата 28.3.2010, 18:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40



3 копии одного постинга -- это для резервного копирования?
PM MAIL ICQ   Вверх
birdfree
Дата 28.3.2010, 18:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 24
Регистрация: 12.12.2008

Репутация: 1
Всего: 1



Я извиняюсь но сам не понимаю почему так получилось. Я только один пост писал. И делал один просмотр. Попрощу модерацию удалить 2 прошлых поста.
И еще у меня тут проблема появилось в скрипте, нужно сделать что бы при архивации можно было исключать файлы по маске для примера исключать: *.ls *.bk *.div *text.bk name*.ff Если помножите буду очень благодарен  
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl"
korob2001
sharq
  • В этом разделе обсуждаются общие вопросы по языку Perl
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Если ваш вопрос относится к CGI программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", можно скачать здесь


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Perl: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.0817 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.