melguin has asked for the wisdom of the Perl Monks concerning the following question:

I've been trying to debug this (very) simple program all morning, and so I don't think I'm seeing it right anymore. I've looked through my books and nodes on PM, but I have not found anything that helps.

What this is supposed to do is reproduce the file structure in one directory (recursively), but instead of copying the files it creates new ones with the same name (all with the same content contained in $redirect_page).

my $htdocs_dir = "/home/httpd/htdocs"; my $disabled_htdocs = "/home/httpd/htdocs_disable"; check_dir("."); #takes: a directory name sub check_dir { my $dir = shift; #defined $dir || $dir = ""; my $path = "$htdocs_dir/$dir"; opendir (DIR, $path) || die "Can't open $htdocs_dir/$dir: $!"; while (defined (my $dir_file = readdir DIR)) { if (-d "$path/$dir_file") { unless ($dir_file eq '.' || dir_file eq '..') { mkdir("$disabled_htdocs/$dir/$dir_file",0755); check_dir("$dir/$dir_file"); } } elsif (-f "$path/$dir_file") { add_file("$dir/$dir_file") } } #takes: file (with path) sub add_file { my $file = shift; open FILE, ">$disabled_htdocs/$file" || die "Can't open $file: + $!"; print FILE $redirect_page; print "wrote $disabled_htdocs/$file\n";##!! this never prints close FILE; } }
My problem is that it doesn't seem to be writing the files and only goes into one directory.

thanks, a very tired melguin.

Replies are listed 'Best First'.
Re: simple recursive sub from hell.
by Cine (Friar) on Aug 24, 2001 at 02:26 UTC
    ALWAYS use strict and warnings
    unless ($dir_file eq '.' || dir_file eq '..') { should be unless ($dir_file eq '.' || $dir_file eq '..') {

    Update:

    btw it wont work unless the directory $disabled_htdocs already exists.

    T I M T O W T D I
Re: simple recursive sub from hell.
by Rudif (Hermit) on Aug 24, 2001 at 03:03 UTC
    A tired melguin wrote

    >> What this is supposed to do is reproduce the file structure in one directory (recursively), but instead of copying the files ...

    Sounds similar to what my script below does - it replicates a directory tree - directories and files. Even if your needs are different, perhaps this can help.

    #! perl -w # replicates files from source directory to destination directory use strict; use File::Basename; use File::Copy; use File::Find; use File::Path; # usage # my $usage = <<ENDUSAGE; replicate -s <sourcedir> -d <destdir> -e <extension [...]> [-q] [-h] Replicates each file in source directory and its subdirectories into the destination directory and its subdirectories if source file has one of the specified extensions and the destination file is older or inexistent. Creates the destination directory and it's subdirectories if inexist +ent. -d must be followed by the full path name of the destination dire +ctory -e must be followed by one or more space-separated extensions -h print help text and exit -msvc may be given instead of -e and will copy all non-regenerabl +e msvc files -q query (print the filenames due for replication) -s must be followed by the full path name of an existing source d +irectory ENDUSAGE # parse arguments # my ($sourcedir, $destdir, @extensions, $query); while (@ARGV) { my $arg = shift; if ($arg eq '-s') { $sourcedir = shift; } elsif ($arg eq '-d') { $destdir = shift; } elsif ($arg eq '-e') { while ($ARGV[0] && $ARGV[0] !~ /^-/) { push @extensions, shift; } } elsif ($arg eq '-msvc') { push @extensions, qw / bmp c cpp def dlg dsp dsw h ico idl mak + odl rc rc2 rgs /; } elsif ($arg eq '-q') { $query = 1; } elsif ($arg eq '-h') { print STDERR $usage; exit; } else { errorExit("Unknown option or argument: $arg"); } } if (! -d $sourcedir) { errorExit("Please specify an existent source directory ($sourcedir + inexistent)"); } my $extensions; if (@extensions) { $extensions = join "|", @extensions; } else { errorExit("Please specify at least one extension"); } if (! -d $destdir) { mkdir $destdir, 777 || die "Could not create directory $destdir"; print STDERR "Created directory $destdir\n"; } # change '\' to '/' (avoids trouble in substitutions) # $sourcedir =~ s|\\|/|g; $destdir =~ s|\\|/|g; #print STDERR "$sourcedir $destdir\n"; # do it # find(\&copyIfNeeded, $sourcedir); # subroutines # sub copyIfNeeded { if (/\.($extensions)$/i) { # filename has a valid extension my $srcsubdir = $File::Find::dir; (my $destsubdir = $srcsubdir) =~ s!$sourcedir!$destdir!; # print STDERR "$srcsubdir/$_ -> $destsubdir/$_\n" ; if (! -d $destsubdir) { if ($query) { print STDERR "Should create directory $destsubdir\n"; } else { mkpath($destsubdir, 1, 0777) || die "Could not create +directory $destsubdir"; # mkpath can create a multilevel path (unlike mkdir) print STDERR "Created directory $destsubdir\n"; } } my $srcfile = "$srcsubdir/$_"; my $destfile = "$destsubdir/$_"; if ((!-f $destfile) || isNewer($srcfile, $destfile)) { if ($query) { print STDERR "Should copy file $srcfile to $destfile\n +"; } else { if (-f $destfile && !-w $destfile) { chmod 0777, $destfile; } print STDERR "$srcfile to $destfile ..."; if (copy($srcfile, $destfile)) { print STDERR " replicated\n"; } else { warn "Could not copy file $srcfile to $destfile\n" +; } } } else { print STDERR "$destfile OK\n"; } } } sub errorExit { my $msg = shift; print STDERR "*** $msg ***\n"; print STDERR $usage; exit; } sub mtime { my $file = shift; my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ct +ime,$blksize,$blocks) = stat($file); $mtime; } sub isNewer { my ($file1, $file2) = @_; return &mtime($file1) > &mtime($file2); } __END__ =head2 AUTHOR rudif@bluemail.ch I wrote this a long time ago, before I knew about Getopt::Long. And Pe +rlMonks. Use it as you like. =cut
    HTH

    Rudif

Re: simple recursive sub from hell.
by premchai21 (Curate) on Aug 24, 2001 at 04:29 UTC

    On *n?x: cp -R.
    On Win32: xcopy /s.
    On Mac: should automatically do recursivity on copy.