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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> рекурсивная сортировка каталогов/файлов, время последней модификации каталога  
:(
    Опции темы
heluna
Дата 29.3.2010, 11:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Я хочу написать скрипт, который рекурсивно пробегает все элементы (каталоги и файлы) открытого каталога DIR (C:/programme/dir).

 И сортирует их по времени последней модификации. Все элементы, которые больше года не открывались, нужно перенести в новый каталог BACKUP (C:/programme/backup/dir) и стереть в старом DIR.

Ко всему этому надо создать текстовый файл (liste.txt), где будут выписаны все удалённые элементы с текущей директории и их
 
качества:
    название элемента(filename/dirname)
    размер в KB(sizeDir, sizeFile))
    время, когда последний раз пользовались файлом/папкой(lastMod)

я уже не знаю, сколько раз я начинала переписывать этот скрипт, но ни к чему умному я не пришла, причём я в самом деле инвестировала много времени ))) smile 
Может у кого было что-то подобное....подскажите как это осуществить...

Буду благодарна любой помощи!!.....................................!!

пока я только умудрилась, выдать в текстовом файле все элементы текущей директории, потом я хотела вывести размеры в КБ, но выдача получается неправильной.......................
Код

#!/usr/bin/perl
use strict;
use Cwd;

#
my $olddir;


do
{
    print "Geben Sie bitte den Verzeichniss an:";
    $olddir = <STDIN>;
    chomp $olddir;
}

my $backupdir = " ???/Backup/Olddirname ";#новая папка Backup
my $backupdirname = "Backup";

while( !defined $olddir || $olddir eq '');
opendir(ORDNER, $ordner) || die "Can't open directory '$ordner': $!";
my @files = readdir(DIR);
my $size = folder_size($ordner);
close ORDNER;

#список 
my $logfile = "$ordner/Liste.txt";
open(LOGFILE,">$logfile") or die $!;

my @queue = ($ordner);
while (@queue) {
    my $dir = shift @queue;
    chdir $dir;
    my $path = getcwd;
    my $dirsize = folder_size(${path});
    $dirsize = $dirsize / 1024;

    #вписать даты в текстфайл
    print LOGFILE "${path}----->$dirsize KB\n=============\n";
    opendir DIR, '.';

    while (my $file = readdir DIR) {
        next if ($file eq '.' || $file eq '..');
           my $filesize = folder_size($_);
           $filesize = $filesize / 1024;
        push @queue, "${path}/${file}" if (-d $file);
        print LOGFILE "$file----->$filesize KB";
        print LOGFILE "\n";

    }
    print LOGFILE "=============\n";
    closedir DIR;
}
close LOGFILE;



sub folder_size {


my $pfad = shift;
local *DIR;
my @dateien = ();
my $pfadtotal = '';
my $groesse = 0; #size



opendir(DIR, $pfad);
@dateien = readdir(DIR);
closedir(DIR);


  foreach my $datei (@dateien) {
    next if  ($datei eq '.' || $datei eq '..');

    print "FILE: $pfad\n";
    $pfadtotal = "$pfad/$datei";
    if(-d $pfadtotal) {
      print "DIRECTORY: $pfadtotal\n";
      $groesse += folder_size($pfadtotal);
    } else {
      $groesse += -s $pfadtotal;

    }
  }


return ($groesse);

}
   
PM MAIL   Вверх
amg
Дата 29.3.2010, 13:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

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



Для начала:
Код
use File::Find;

my $DIR = 'C:/programme/dir';
my %stat;

# рекурсивно пробегает все элементы (каталоги и файлы) каталога $DIR
find( {wanted => sub {$stat{$File::Find::name} = [stat($File::Find::name)]},
       no_chdir => 1}, 
$DIR);
# stat:
#  0 device number of filesystem
#  1 inode number
#  2 file mode  (type and permissions)
#  3 number of (hard) links to the file
#  4 numeric user ID of file's owner
#  5 numeric group ID of file's owner
#  6 the device identifier (special files only)
#  7 total size of file, in bytes
#  8 last access time in seconds since the epoch
#  9 last modify time in seconds since the epoch
# 10 inode change time in seconds since the epoch (*)
# 11 preferred block size for file system I/O
# 12 actual number of blocks allocated

# сортирует их по времени последней модификации
foreach (sort {$stat{$a}[8]<=>$stat{$b}[8]} keys %stat) {
  print "$_\n";
}


PM MAIL   Вверх
heluna
Дата 29.3.2010, 19:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Ок, сортировать, то он их сортирует, а как эту дату и размер потом в текстовом файле выдать? 
PM MAIL   Вверх
heluna
Дата 29.3.2010, 22:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



наконетц-то допёрла как выдать в текстфайле размеры элементов

Вот мой код:
Код

use strict;
use Cwd;
use File::Find;
use File::stat;
my $size = 0;
my $size_all = 0;
my $i;
#untersuchter Ordner
my $d;

do
{
    print "Geben Sie bitte den Verzeichniss an:";
    $d = <STDIN>;
    chomp $d;
}

while( !defined $d || $d eq '');
opendir(D, $d) || die "Can't open directory '$d': $!";
my @files = readdir(D);


#Liste
my $logfile = "$d/Liste.txt";
open(LOGFILE,">$logfile") or die $!;
close D;

my @queue = ($d);#Reihenfolge von Ordnern
while (@queue) {#Wenn die Reihe noch nicht zu ende ist
    my $dir = shift @queue;#den ersten Element rausholen
    chdir $dir;#gehen in den Ordner rein
    my $path = getcwd;#vollständiger Pfad
#---------------------------------------------
     find(\&d_scan, $path);
     $size_all = $size_all/1000;
#------------------------------------------------
    #Pfad in der Liste rausgeben
    print LOGFILE "${path}--->Ordnergröße: $size_all KB \n=============\n";
    opendir DIR, '.';

    while (my $file = readdir DIR) {
        next if ($file eq '.' || $file eq '..');
        push @queue, "${path}/${file}" if (-d $file);
#---------------------------------------------------------------
        find(\&d_scan, $file);#Methode aufrufen
        $size_all = $size_all/1000;
#-----------------------------------------------------------------
        print LOGFILE "$file Größe: $size_all KB";
        print LOGFILE "\n";

    }
    print LOGFILE "=============\n";
    closedir DIR;
}
close LOGFILE;

#-------------------------
sub d_scan{
  my $st = stat($_);
   $size = $st->size;
   $size_all += $size;
   $i++;
}
#-----------------------



как выдать это дело в такой форме например...

C:/Users/cthdev34/Desktop/man                      Размер: 28.022 KB 
                                                                          Время последней модификации:31.08.2007 17:46
=============
Active.css Größe             ---> Датай                  Размер: 15.22 KB 
                                                                          Время последней модификации:24.08.2007 18:46

Liste.txt Größe               ---> Датай                   Размер: 0.002 KB 
                                                                          Время последней модификации:28.03.2007 15:46

images Größe                ---> Каталог
=============
C:/Users/cthdev34/Desktop/man/images         Размер: 2.21 KB 
                                                                         Время последней модификации:31.08.2007 17:00 
=============
activeperl_logo.gif          ---> Датай                  Размер: 0.69 KB 
                                                                          Время последней модификации:31.08.2007 17:46

Code.gif                          ---> Датай                 Размер: 1.52 KB 
                                                                         Время последней модификации:31.08.2007 17:46
=============        

На данный момент моя запись в файле выглядит так:

C:/Users/cthdev34/Desktop/man--->Размер: 28.022 KB 
=============
Active.css Размер: 15.229022 KB
images Размер: 2.21206024433023 KB
Liste.txt Размер: 0.00221206024433023 KB
=============
C:/Users/cthdev34/Desktop/man/images--->Размер: 2.21000221206024 KB 
=============
activeperl_logo.gif Размер: 0.69821000221206 KB
Code.gif Размер: 1.52024433022902 KB
=============

как округлить числа до 2-ой десятой???
Ну и конечно же хотелось бы знать, можно ли этому тексту передать ту форму, которую я сама записала выше. 
С датой и временем что-то вообще труба, чем дальше в лес, тем больше дров....





PM MAIL   Вверх
amg
Дата 30.3.2010, 10:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

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



heluna,  не все понятно. Поясните, пожалуйста,
1. Зачем сортировать файлы по времени? Что с сортированным списком делать? Вы же понимаете, напечатать этот список в том виде, в каком Вы предложили в своем последнем посте, не получится. И по какому времени? Есть время последнего доступа (кто-то просмотрел файл, не не правил его), есть время последней модификации.
2. Переместить старые файлы и создать лог-файл об этом -- это понятно. А что делать с директориями, которые после перемещения оказались пустыми? Оставлять или удалять?
3. Насколько я понял, Вы сами парсите файловую систему. Зачем тогда File::Find?

Что касается Ваших вопросов о размере файла и времени, то вот в качестве примера: 
Код
use File::stat;

my $file = 'C:/Users/cthdev34/Desktop/man/Active.css';
my $st = stat($file);

printf "%-40s Размер: %s\n%-40s Время последней модификации: %s\n", 
       $file, printable_size($st->size), '', printable_time($st->mtime);

sub printable_time {
  my $time = shift;
  return $time if $time !~ /^\d+$/;
  my (undef,$min,$hour,$mday,$mon,$year) = localtime($time);
  return sprintf "%02d.%02d.%04d %02d:%02d", $mday,$mon+1,$year+1900,$hour,$min;
}

sub printable_size {
  my $size = shift;
  return $size if $size !~ /^\d+$/;
  my $suffix = 'B';
  foreach (qw(KB MB GB)) {
    last if $size < 1000;
    $size /= 1024;
    $suffix = $_;
  }
  my $format = ($suffix eq 'B' ? "%d " : "%.2f ").$suffix;
  return sprintf $format, $size;
}


PM MAIL   Вверх
heluna
Дата 30.3.2010, 10:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



спасибо за ответ amg))))
поясняю...
1. нет, мне было это не понятно, до данного момента, что в этом виде этот список нельзя выдать, но это не настоль важно...
сортировка нужна для того, что-бы в папке остались только актуальные элементы, это те которые по возврасту меньше года, все те элементы, которые старше года не актуальные и по этому их надо перенести в другую папку, что-бы они не мешались, но на всякий случай их надо сохранить, что-бы можно было в любой момент их опять востановить. Что-бы сразу было видно, какие элементы перенесены в другой орднер, делается список с данными от этих элементов. 

2.Вообще структура в Backup должна соответствовать структуре папки, которую проверяю, это значит, если директория осталась пустой, то в старой папке её надо стереть, но в новую папку перенести.......(я надеюсь, я понятно выразилась)

3.Зачем File:Find не знаю видела пару примеров и решила их под свой подделать........это моя первая программа на перле(как было и не трудно догодаться)))))


БОЛьШОЕ СПАСИБО ЗА ПРИМЕР, сейчас буду пробовать....)))
PM MAIL   Вверх
amg
Дата 30.3.2010, 14:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

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



Цитата(heluna @  30.3.2010,  10:56 Найти цитируемый пост)
сортировка нужна для того, что-бы в папке остались только актуальные элементы, это те которые по возврасту меньше года
Сортировка то для этого зачем? Если файлов много, то это дорогое удовольствие. Чтобы определить возраст файла, сортировка не нужна:
Код
if (-M $file > 365) {
  # переносим файл
}

Код
$now = time;
if ($now-$st->mtime  > 365*24*3600) {
  # переносим файл
}


PM MAIL   Вверх
heluna
Дата 30.3.2010, 15:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



проблема в том что в каталоге не только файлы находятся, там ещё и подкаталаги, в которых и подподкаталаги в которых тоже находятся файлы.............................. вот в этом то вся и проблема

Это сообщение отредактировал(а) heluna - 30.3.2010, 15:53
PM MAIL   Вверх
shamber
Дата 30.3.2010, 16:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

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



heluna, а почему проблема? можно ведь и их обходить предложенным amg вариантом 
PM MAIL Jabber   Вверх
heluna
Дата 30.3.2010, 16:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



а где имено он их там объеденяет????

Ну в общемто, я тоже об этом подумала, и объеденила их, но моя версия намного длиннее, и я не совсем понимаю если честно, в каком месте это делается в скрипте, предложенном amg

я это делаю вот так:

Код

#!/usr/bin/perl
use strict;
use Cwd;
use File::stat;

 my @files;# это только файлы
 my @dirs;#это только папки
 my @inhalt;#это моя будущая листэ, где находятся все элементы включая, папки и файлы


#untersuchter Ordner
my $d ;

do
{
    print "Geben Sie bitte den Verzeichniss an:";
    $d = <STDIN>;
   chomp $d;
}

#while( !defined $d || $d eq '');
opendir(D, $d) || die "Can't open directory '$d': $!";
  while(@inhalt = readdir(D)){

closedir(D);

folder_size($d);#вызываю метод, где я сортирую все элементы, на папки и файлы



for (my $fil=0; $fil < @files ; $fil++){

my $filesize = folder_size(@files, $fil);
$filesize = $filesize / 1024;

print "Datei:$files[$fil]\tGrösse $filesize KB\n";

}



for (my $element=0; $element < @inhalt ; $element++){

my $gesamtsize = folder_size(@inhalt,$element);
$gesamtsize = $gesamtsize / 1024;

print "Elemente: $inhalt[$element]  \t Grösse $gesamtsize KB\n\n";
}



 for (my $dire=0; $dire < @dirs ; $dire++){

my $dirsize = folder_size(@dirs,$dire);
    $dirsize = $dirsize / 1024;
  print "Ordner:$dirs[$dire] \tGrösse $dirsize KB\n";
}


#Liste
my $logfile = "$d/Liste.txt";
open(LOGFILE,">$logfile") or die $!;


my @queue = ($d);#Reihenfolge von Ordnern
while (@queue) {#Wenn die Reihe noch nicht zu ende ist
    my $dir = shift @queue;#den ersten Element rausholen
    chdir $dir;#gehen in den Ordner rein
    my $path = getcwd;#vollständiger Pfad




     #----------------------------------------
     my $dirsize = folder_size(${path});
    $dirsize = $dirsize / 1024;
    #--------------------------------------
    #Pfad in der Liste rausgeben


    print LOGFILE "${path}--->Ordnergröße: $dirsize KB \n=============\n";
    opendir DIR, '.';
    while (my $file = readdir DIR) {

        next if ($file eq '.' || $file eq '..');
        push @queue, "${path}/${file}" if (-d $file);
       #------------------------------------------
        my $filesize = folder_size($file);
        $filesize = $filesize / 1024;
       #---------------------------------------------
        print LOGFILE "$file Größe: $filesize KB";
        print LOGFILE "\n";

    }
    print LOGFILE "=============\n";


     #print LOGFILE "\n******************************\n $d Gesammtgrösse:$gesamtsize \n******************************\n";
    closedir DIR;
}
close LOGFILE;
}

#здесь я сортирую все элементы и вычисляю их размер в КВ

sub folder_size {
# Variablen initialisieren
my $pfad = shift;
local *DIR;
my @inhaltdir = ();
my $pfadtotal = '';
my $groesse = 0;

# Verzeichnis lesen
opendir(DIR, $pfad);
@inhaltdir = readdir(DIR);
closedir(DIR);

# Addition oder Rekursion fuer alle gelesenen
  foreach my $datei (@inhaltdir) {
    next if  ($datei eq '.' || $datei eq '..');
    #print "ELEMENT: $pfad\n";
    push(@inhalt,$pfad.$datei);
    $pfadtotal = "$pfad/$datei";
    if(-d $pfadtotal) {
      #print "VERZEICHNIS: $pfadtotal\n";
      push(@dirs,"$pfad\\$datei");
      $groesse += folder_size($pfadtotal);
    } else {
    push(@files,$datei);
      $groesse += -s $datei;
    }
  }

# Rueckgabe in Bytes
return ($groesse);

}

неужели это дело можно сделать в двух строках????????????????
PM MAIL   Вверх
heluna
Дата 1.4.2010, 11:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



извеняюсь ступила, я думала, что File::Find можно пользоваться, только если у меня датаи, без папок...... хочу оправдаться, пользуюсь гениальной книжкой, где функция File::Find даже в оглавлении не стоит..................

задам ещё один вопрос))
 
foreach(@allFiles) {


    if(-M $_ > 365 )
{
    push(@Altfile,$_);

       мove($_,$dirbackup); # $dirbackup это моя новая папка
    }

  }

почему элементы не переносятся???? и как их в статой папке стереть?
PM MAIL   Вверх
amg
Дата 2.4.2010, 07:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

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



Цитата(heluna @  1.4.2010,  11:08 Найти цитируемый пост)
почему элементы не переносятся???? и как их в статой папке стереть?
Стереть то не проблема, а вот чтобы перенести, нужно, чтобы в приемнике было соответствующее дерево директорий. Если этого дерева нет, то его нужно сначала создать:
Код
Move($file_with_path, $bakup_dir) or warn "Can't replace $file_with_path to $bakup_dir\n";

sub Move {
  my ($dir_file, $bakup) = @_;
  my @dirs = split '/', $dir_file;
  my $file = pop @dirs;
  foreach (@dirs) {
    $bakup .= "/$_";
    next if -d $bakup;
    mkdir($bakup) or print("Can't create dir $bakup: $!"),return undef;
  }
  rename($dir_file, "$bakup/$file") or
    print("Can't move $dir_file to $bakup: $!"),return undef;
  return 1;
}


PM MAIL   Вверх
heluna
Дата 16.4.2010, 10:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Я наконетц-то добила этот скрипт и получила всё что мне надо было, (почти).  Я выставлю код, может кому когда-нибудь поможет...

Большое спасибо амг за помощь))

Код

#!/usr/local/bin/perl
use strict;
use warnings;

use File::stat;
use File::Find;
use File::Copy;
use File::Spec;

#my $dir ='C:/Users/cthdev34/Desktop/map';
#my $bakupdir = 'C:/Users/cthdev34/Desktop/map/bakup';

#--------------------Ordner der durchsucht wird-----------------
my $dir;
do
{
    print "Geben Sie bitte den Verzeichniss an:";
    $dir = <STDIN>;
    chomp $dir;
}
while( !defined $dir || $dir eq '');
#---------------------------------------------------------------

my $pfad_total = $dir;
my @pfad = split(/\\/, $dir);
my $dirname = $pfad[-1];


#-------------------------Temp-Ordner--------------------------
my ($volume, $directories, $file) = File::Spec->splitpath( $dir );
my @dires = File::Spec->splitdir( $directories );
$file = File::Spec->catdir( "\\Temp_$dirname", @dires );
my $bakupdir = File::Spec->catpath( $volume,  $file );
#---------------------------------------------------------------


my $logFile = "$dir/Liste.txt"; #Textdatei mit Elementen, die verschoben wurden
my $inum_Tage = 20; #Wie alt soll der Element sein

my @sortFiles; #Elemente älter als 30 Tage
my @dirs; #alle Ordner
my @fils; #alle Dateien

#--------------------Sortierung der Elemente----------------------
find(\&sort,$dir);

sub sort {
  my $file = $File::Find::name;
  my $file_rel=File::Spec->abs2rel($file,$dir);
  push(@dirs,$file) if (-d $file);
  push(@fils, $file) if (-f $file);
  push(@sortFiles,$file_rel) if ( -M $file  > $inum_Tage);
}

print "Ordner:   $_\n" for(@dirs);
print "Datei:    $_\n" for(@fils);
print "Verschoben: $_\n" for(@sortFiles);
#---------------------------------------------------------------


#----------Übergabe von Parametern an die Funktionen------------


#Erzeugung von Textliste
write_log($logFile,$dir,$bakupdir,[sort @sortFiles]); #ananymes ARRAY

#Verschiebung von Elementen
for my $file (sort @sortFiles)
{
  move_file($file,$dir,$bakupdir);
  rmdir($file);
}

#leere Ordner löschen
 foreach my $Ordner(@dirs){rmdir($Ordner);}


#-----------------------------------------------------------------


###############################################################################
############################## FUNKTIONEN #####################################
###############################################################################

#LOGDATEI
#******************************************************************************
sub write_log{

  my $files=shift;
  my $src=shift;
  my $dst=shift;
  my @liste=@{shift(@_)}; #<=ARRAY-Referenz (das anonyme Array von oben)

  open(my $logf,'>',$files) or die $!;
  print $logf "\t\t\t $pfad_total \n";
  print $logf "\t\t*****************************************************\n\n\n";
  for my $file (@liste)
  {
    my $src_file=File::Spec->rel2abs($file,$src);
    my $st = stat($src_file);

    print $logf "$src_file \n\n",
     "  \t\t        Größe:", format_size($st->size),
     "  \t Änderungsdatum:", format_time($st->mtime), "\n\n\n";
  }
  close($logf);
}


#ZEIT
#******************************************************************************
sub format_time {
  my $time = shift;
  return $time if $time !~ /^\d+$/;
  my (undef,$min,$hour,$mday,$mon,$year) = localtime($time);
  return sprintf "%02d.%02d.%04d %02d:%02d", $mday,$mon+1,$year+1900,$hour,$min;
}


#GRÖßE
#******************************************************************************
sub format_size {
  my $size = shift;
  return $size if $size !~ /^\d+$/;
  my @list=qw(Kb Mb Gb Tb);
  my $suffix = 'Byte';

  while($size>1024 && @list)
  {
    $suffix=shift(@list);
    $size /= 1024;
  }

  my $format = ($suffix eq 'B' ? "%d " : "%.2f ").$suffix;
  return sprintf $format, $size;
}


#STRUKTUR VON DIREKTORYS ERZEUGEN
#*****************************************************************************

sub move_file
{
  my ($file, $src, $dst) = @_;

  #nötigen Pfade zum kopieren zu erzeugen
  my $dst_file = File::Spec->rel2abs($file,$dst);
  my $src_file = File::Spec->rel2abs($file,$src);

  #im Laufwerk und Ordnern bei bedarf die nötigen Verzeichnisse erstellen
  my ($volume,$directories,$files) = File::Spec->splitpath($dst_file);
  make_dirs(File::Spec->catpath($volume, $directories));

  # verschieben der Datei
  move($src_file,$dst_file);

 # return ;
}


#VERZEICHNISSE ERZEUGEN, WENN SIE NICHT EXISTIEREN
#*****************************************************************************

sub make_dirs
{
  my $path=shift;

  my $dnow='';
  ($dnow,$path)=File::Spec->splitpath($path, 1);
  for(File::Spec->splitdir($path))
  {
    $dnow=File::Spec->join($dnow, $_);
    unless(-d $dnow)
    { mkdir($dnow) or die("ERROR mkdir: $dnow ($!)"); }
  }
}


я написала почти.....потому-что в этом месте 
#leere Ordner löschen
 foreach my $Ordner(@dirs){rmdir($Ordner);}

я пытаюсь стирать пустые папки, что и получается, но только до того момента, когда папка которую изначально пробегаю имеет только одну поддеректорию, если в этих папках находятся дальнейшие папки, то скрипт оставляет их пустыми.

Подскажите пожалуйсто, как это дело исправить....

Это сообщение отредактировал(а) heluna - 16.4.2010, 10:47
PM MAIL   Вверх
heluna
Дата 16.4.2010, 11:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



я сама решила эту проблему, выделенную часть кода надо заменить на
Код

rmdir($_) for(reverse(@dirs));

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


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

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


 




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


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

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