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

Hello Monks,

I've been trying to diagnose trouble getting content to my site but could hardly wade through the tons of stuff, now mostly junk, that needed to be cleaned out. I tried to use filezilla to machete my way through it, but that goes very slowly when every page has an html component, a corresponding image component, and css as well. Therefore I decided that writing a script to delete entire classes of content was necessary.

I've got it far enough to where I'd like to ask for help. Here's the caller:

#!/usr/bin/perl -w use strict; use 5.010; use lib "template_stuff"; use html2; use Net::FTP; say "What keyword would you like to delete?"; my $word = <>; chomp $word; say "Delete everything associated with $word? (Y for yes)"; my $answer = <>; chomp $answer; die unless ( $answer eq 'Y' or 'y' ); # main data structure my %vars = ( word => $word, page => 'pages', image => 'images', css => 'css', ); my $rvars = \%vars; my $rftp = get_ftp_object(); my $rfiles = get_html_filenames( $rftp, $rvars ); my $rptr = kill_files( $rftp, $rvars, $rfiles ); my @killed = @$rptr; say "killed were @killed "; __END__

Q1: Why is my die statement completely ineffectual? I tried ||, grouping with parens, and "". Do I just flub the logic?

I think the intent is pretty clear with the first 2 subroutines, omitted for brevity. There's nothing exotic about getting an ftp object. The reference is passed to get_html_filenames, which gets matches, sent back as another reference to an array. kill_files is very much a work in progress:

sub kill_files { use Net::FTP; use 5.010; use Path::Class; my ( $ftp, $rvars, $rfiles ) = @_; my %vars = %$rvars; my @files = @$rfiles; my @killed_files; # kill html files for my $html (@files) { my $obj = file( '', $vars{page}, $html ); my $string = $obj->stringify; say "string is $string"; my $return = $ftp->delete($string); if ($return) { push( @killed_files, $html ); } } # chop off ending foreach (@files) { $_ =~ s/\.html//; } say "now files are @files"; # kill image directories for my $dir (@files) { my $obj = dir( '', $vars{image}, $dir ); my $string = $obj->stringify; say "string is $string"; my $return = $ftp->rmdir($string,1); if ($return) { push( @killed_files, $dir ); } } # kill css file my $css_obj = file( '', $vars{css}, $vars{word} . '1.css' ); my $string = $css_obj->stringify; say "string is $string"; my $return = $ftp->delete($string); if ($return) { push( @killed_files, $html ); } return \@killed_files; }

I was getting good behavior out of this for building up the strings of files and directories to be deleted. The trouble came when I actually tried to delete them, and I got the following typical diagnostics:

Net::FTP=GLOB(0x92dc200)>>> DELE /images/potato1/. Net::FTP=GLOB(0x92dc200)<<< 550 /images/potato1/.: Is a directory Net::FTP=GLOB(0x92dc200)>>> RMD /images/potato1/. Net::FTP=GLOB(0x92dc200)<<< 550 /images/potato1/.: Directory not empty

I was hoping that I could just cut off the directory branch with the rmdir method from Net::Ftp with recurse set to 1, but it would appear that I cannot.

Q2) Do I have to go into every one of these directories, delete every file, and only then will I be able to delete the directory itself? What's the best way of doing that without having to make a bunch of ftp requests?

As usual I'm also accepting any tips for style and reducing superfluous notation. Thanks for your comment.

Replies are listed 'Best First'.
Re: script for deleting html, images and css from server
by Corion (Patriarch) on Apr 04, 2015 at 08:29 UTC
    die unless ( $answer eq 'Y' or 'y' );

    Your syntax is off here. or does not bind strong enough, and even if it did, 'Y' or 'y' will always result in 'Y'.

    You will need to write something like:

    die unless ( $answer eq 'Y' or $answer eq 'y' );
Re: script for deleting html, images and css from server
by Laurent_R (Canon) on Apr 04, 2015 at 13:46 UTC
    As Corion correctly said, the error lies in the condition:
    die unless ( $answer eq 'Y' or 'y' );
    which does not work because of the low precedence of or (compared to eq), so that this is parsed essentially as if you had written:
    die unless ( ($answer eq 'Y') or ('y') );
    The right-hand part of the or operator is always true so that even if the user type "N", the condition will always be true. (Note that even using the higher precedence || operator would not help, because its precedence is still lower than the precedence of the eq operator.)

    Deparsing the statement shows this:

    $ perl -MO=Deparse,-p -e 'die unless ( $answer eq "Y" or "y");' ((($answer eq 'Y') or 'y') or die); -e syntax OK

    In Perl 6, though, using an any junction infix operator would allow you to do something similar that would work the way you expected:

    > my $answer = "y"; y > say "true" if $answer eq 'Y' | 'y'; true > say "true" if $answer eq 'N' | 'y'; true > say "true" if $answer eq 'N' | 'n'; Nil >

    Je suis Charlie.
Re: script for deleting html, images and css from server
by Anonymous Monk on Apr 04, 2015 at 14:42 UTC
    Q2) Do I have to go into every one of these directories, delete every file, and only then will I be able to delete the directory itself?

    AFAIK yes; at the very least it's the most portable way of deleting a tree of files & dirs.

    What's the best way of doing that ...?

    As you said, recursively enter each directory depth-first and delete the files, then delete any empty directories. The "recurse" option of Net::FTP is supposed to do that, but to help you out we need a better description of the problems you're having than "it would appear that I cannot".

      Thanks all for replies. I went ahead and wrote script for deleting the images in a given directory, and I don't really have to worry about a deeper structure than that, because the design of the template that creates it has no depth beyond level one. Here is now typical output:

      Net::FTP=GLOB(0x919f390)<<< 150 Opening ASCII mode data connection for + file list Net::FTP=GLOB(0x919f390)<<< 226 Transfer complete to_kill is /images/brick5/jm2.jpg Net::FTP=GLOB(0x919f390)>>> DELE /images/brick5/jm2.jpg Net::FTP=GLOB(0x919f390)<<< 250 DELE command successful to_kill is /images/brick5/photo 1.JPG Net::FTP=GLOB(0x919f390)>>> DELE /images/brick5/photo 1.JPG Net::FTP=GLOB(0x919f390)<<< 250 DELE command successful to_kill is /images/brick5/photo 2.JPG Net::FTP=GLOB(0x919f390)>>> DELE /images/brick5/photo 2.JPG Net::FTP=GLOB(0x919f390)<<< 250 DELE command successful to_kill is /images/brick5/s.jpg Net::FTP=GLOB(0x919f390)>>> DELE /images/brick5/s.jpg Net::FTP=GLOB(0x919f390)<<< 250 DELE command successful Net::FTP=GLOB(0x919f390)>>> RMD /images/brick5 Net::FTP=GLOB(0x919f390)<<< 250 RMD command successful string is /css/brick1.css Net::FTP=GLOB(0x919f390)>>> DELE /css/brick1.css Net::FTP=GLOB(0x919f390)<<< 250 DELE command successful killed were brick1.html brick2.html brick3.html brick4.html brick5.htm +l /images/brick1/jm2.jpg /images/brick1/photo 1.JPG /images/brick1/ph +oto 2.JPG /images/brick1/s.jpg brick1 /images/brick2/jm2.jpg /images/ +brick2/photo 1.JPG /images/brick2/photo 2.JPG /images/brick2/s.jpg br +ick2 /images/brick3/jm2.jpg /images/brick3/photo 1.JPG /images/brick3 +/photo 2.JPG /images/brick3/s.jpg brick3 /images/brick4/jm2.jpg /imag +es/brick4/photo 1.JPG /images/brick4/photo 2.JPG /images/brick4/s.jpg + brick4 /images/brick5/jm2.jpg /images/brick5/photo 1.JPG /images/bri +ck5/photo 2.JPG /images/brick5/s.jpg brick5 /css/brick1.css $

      You can see how this would be tedious to do with filezilla. With the caller, I made the change in the die statement (thank you) and also removed the use Net::FTP, as that was relegated to subroutines only:

      #!/usr/bin/perl -w use strict; use 5.010; use lib "template_stuff"; use html2; say "What keyword would you like to delete?"; my $word = <>; chomp $word; say "Delete everything associated with $word? (Y for yes)"; my $answer = <>; chomp $answer; die unless ( $answer eq 'Y' or $answer eq 'y' ); # main data structure my %vars = ( word => $word, page => 'pages', image => 'images', css => 'css', ); my $rvars = \%vars; my $rftp = get_ftp_object(); my $rfiles = get_html_filenames( $rftp, $rvars ); my $rptr = kill_files( $rftp, $rvars, $rfiles ); my @killed = @$rptr; say "killed were @killed "; __END__

      This version of kill_files seems to function and behave as desired:

      sub kill_files { use Net::FTP; use 5.010; use Path::Class; my ( $ftp, $rvars, $rfiles ) = @_; my %vars = %$rvars; my @files = @$rfiles; my @killed_files; # kill html files for my $html (@files) { my $obj = file( '', $vars{page}, $html ); my $string = $obj->stringify; say "string is $string"; my $return = $ftp->delete($string); if ($return) { push( @killed_files, $html ); } } # chop off ending foreach (@files) { $_ =~ s/\.html//; } say "now files are @files"; # kill image files and directories for my $dir (@files) { my $obj = dir( '', $vars{image}, $dir ); my $path = $obj->stringify; say "path is $path"; $ftp->cwd($path) or warn "Cannot change working directory ", $ftp->message; my @remote_files = $ftp->ls(); for my $file (@remote_files) { next if $file eq '.' or $file eq '..'; my $to_kill = file( $path, $file ); say "to_kill is $to_kill"; my $return = $ftp->delete($to_kill); if ($return) { push( @killed_files, $to_kill ); } } my $return = $ftp->rmdir($path); if ($return) { push( @killed_files, $dir ); } } # kill css file my $css_obj = file( '', $vars{css}, $vars{word} . '1.css' ); my $string = $css_obj->stringify; say "string is $string"; my $return = $ftp->delete($string); if ($return) { push( @killed_files, $string ); } return \@killed_files; }

      I'm still interested in other ways to do this. Happy weekend.

        Moving use to a subroutine, if the subroutine is in the same file, has no effect for non-pragmatic modules. It's executed at compile time when the subroutine is being compiled, not at the time when it's being called.
        لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: script for deleting html, images and css from server
by Anonymous Monk on Apr 04, 2015 at 14:30 UTC

    Just for fun, throwing a few more possible solutions out there:

    use warnings; use strict; while (1) { print "Answer: "; chomp( my $answer = <STDIN> ); use Quantum::Superpositions 'any'; # OR #use Perl6::Junction 'any'; warn "not yes 1" unless $answer eq any('y','Y'); warn "not yes 2" unless $answer =~ /^(y|Y)$/; # be a little more flexible: warn "not yes 3" unless $answer =~ /^y(es)?$/i; last if $answer=~/quit|exit/i; }