moving unused of a website

M

Marek

Hello all,


I am a perl beginner. So patience please!


I wrote a perl-script to find all unused pix of a web site. Now I
would like to move all those 168! pix from the folder pix to the
folder pix_out keeping the same hierarchy as in the original folder.
That means:

/Users/xxx/Documents/webpages/www.myproject.de/pix/fotos/thumbnails/
tn_munich28.jpg

should be renamed to:

/Users/xxx/Documents/webpages/www.myproject.de/pix_out/fotos/
thumbnails/tn_munich28.jpg

Only one folder is changing his name: pix -> pix_out And this with all
my 168 unused pix in different folders.

I was hoping, that the rename function would create the missing
folders, doing:

rename "/Users/xxx/Documents/webpages/www.myproject.de/pix/fotos/
thumbnails/tn_munich28.jpg", "/Users/xxx/Documents/webpages/
www.myproject.de/pix_out/fotos/thumbnails/tn_munich28.jpg";

But there is even no error message, trying to do it like this with one
test file. So probably I have to grep out the folders starting from
"pix"-folder until the file:

this would give in this example the folders fotos -> thumbnails which
are missing and which I have to create in pix_out - folder

My questions are:

How to grep these missing folders? Starting from pix, my hierarchy is
maximum 2 folders deep. But if there would be more folders?

how to test whether a folder is already created? I tried with:

if (-e ! $dir_pix_out)
#wrong!!
{
mkdir
$dir_pix_out;
}



thank you for your help



marek
 
A

A. Sinan Unur

(e-mail address removed)
m:
I am a perl beginner.

You are a Perl beginner. Perl is the language, perl is the binary.

perldoc -q difference
So patience please!


I wrote a perl-script to find all unused pix of a web site. Now I
would like to move all those 168! pix from the folder pix to the
folder pix_out keeping the same hierarchy as in the original
folder. That means:

/Users/xxx/Documents/webpages/www.myproject.de/pix/fotos/
thumbnails/tn_munich28.jpg

should be renamed to:

/Users/xxx/Documents/webpages/www.myproject.de/pix_out/fotos/
thumbnails/tn_munich28.jpg

Learn to use the right tool for the job. The command line tool move
is perfect for this.

move /Users/xxx/Documents/webpages/www.myproject.de/pix
/Users/xxx/Documents/webpages/www.myproject.de/pix_out
Only one folder is changing his name: pix -> pix_out And this with
all my 168 unused pix in different folders.

I am not sure what you mean by this.

I was hoping, that the rename function would create the missing
folders, doing:

rename "/Users/xxx/Documents/webpages/www.myproject.de/pix/fotos/
thumbnails/tn_munich28.jpg", "/Users/xxx/Documents/webpages/
www.myproject.de/pix_out/fotos/thumbnails/tn_munich28.jpg";

But there is even no error message, trying to do it like this with
one test file.

Why would there be an error message if you don't ask for it?

#!/usr/bin/perl

use strict;
use warnings;

my ($old, $new) = ( 'does not exist', 'miracle' );

rename $old => $new
or die "Cannot rename '$old' to '$new': $!";

__END__

C:\Temp> t9
Cannot rename 'does not exist' to 'miracle': No such file or
directory at C:\Temp\t9.pl line 8.
how to test whether a folder is already created? I tried with:

if (-e ! $dir_pix_out)

WTF?

mkdir $dir unless -d $dir;

or

mkdir $dir unless ! -d $dir;

or

if ( ! -d $dir ) {

}

C:\Temp\t> cat t0.pl
#!/usr/bin/perl

use strict;
use warnings;

mkdir 's' unless -d 's';

mkdir 't' if ! -d 't';

if ( ! -d 'u' ) {
mkdir 'u';
}

unless ( -d 'v' ) {
mkdir 'v';
}

__END__

C:\Temp\t> t0

2008/04/15 10:14 AM <DIR> s
2008/04/15 10:14 AM <DIR> t
2008/04/15 10:14 AM <DIR> u
2008/04/15 10:14 AM <DIR> v


However, testing and creation of the directory is not done in a
single atomic transaction. Therefore, testing the existence of the
directory before attempting to create it is of dubious use. Just do

mkdir $dir;

and make sure to check for errors in subsequent file operations
because a directory that existed a few statements back can disappear
once you reach the file operations.

Sinan

--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/
 
M

Marek

Thank you Sinan and Peter for you prompt answers!


Meanwhile I made some progress myself. I am reading in the file name
of the unused pix, and then a grep starting with my "pix" folder, and
then splitting over '/'. The result is three array elements, and the
file name. I am testing, whether the two folders are existing, and if
not, create them. Is this a good approach? (My test script follows on
the bottom).

But I will think over your hints and try to integrate your advices!


marek


#! /usr/local/bin/perl

use strict;
use warnings;
use Data::Dumper;

my $start_dir = "/Users/xyz/Documents/webpages/www.myproject.de";

my $pix_unused_pix =
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/fotos/
thumbnails/tn_munich17.jpg"; # an example of an unused pix

my ($path) = $pix_unused_pix =~ m~/pix/([^"]+?)$~;

my @folders = split("/",$path);


print "The missing folders are:\n\n";
print Dumper(@folders);
print "\n\n";

chdir($start_dir);

if (-e $folders[1]) {
print "\nYes, your folder /$folders[1] exists!\n\n";
}

if (!-e $folders[1]) {
print "\nNO! Your folder /$folders[1] does not exists!\n\n";
mkdir $folders[1];
}

if (-e $folders[1].'/'.$folders[2]) {
print "\nYes, your folder /$folders[1]/$folders[2] exists!\n\n";
}

if (!-e $folders[1].'/'.$folders[2]) {
print "\nNO! Your folder /$folders[1]/$folders[2] does not exists!
\n\n";
mkdir $folders[1] . '/' . $folders[2];
}
 
J

Jürgen Exner

Marek said:
Meanwhile I made some progress myself. I am reading in the file name
of the unused pix, and then a grep starting with my "pix" folder, and
then splitting over '/'. The result is three array elements, and the
file name.

You may want to look at File::Basename which has functions to split a
file path into its components.
I am testing, whether the two folders are existing, and if
not, create them. Is this a good approach? (My test script follows on
the bottom).

You may want to look at File::path which provides mkpath() to create
file paths of any depth.
print Dumper(@folders);

Why not a simple
print @folders;

jue
 
M

Marek

Thank you all! Yes I will look into all your suggestions. Meanwhile I
am progressing on my own way but I will seriously look into all your
suggestions tomorrow.


marek


*******I am here now! I will make a subroutine in my perl script out
of it. If you have any suggestions directly to this script ...

#! /usr/local/bin/perl

use strict;
use warnings;


my $start_dir = "/Users/xyz/Documents/webpages/www.myproject.de";
my $pix_out_folder = $start_dir . "/pix_out";
my $pix_unused_pix =
"/Users/xyz/Documents/webpages/www.myproject.de/pix/fotos/thumbnails/
tn_munich17.jpg";

my ($path) = $pix_unused_pix =~ m~/pix/([^"]+?)$~;

my @folders = split( "/", $path );

if ( !-e $pix_out_folder ) {
mkdir $pix_out_folder
or die "could not create your folder: $pix_out_folder! $!";
}

my $first_sub = shift @folders unless $folders[0] =~ m~\.(jpe?g|gif|
png)$~;
$first_sub = $pix_out_folder . '/' . $first_sub if $first_sub;

if ( $first_sub and !-e $first_sub ) {
print "\nNO! Your folder /$folders[1] does not exists!\n\n";
mkdir $first_sub or die "could not create your folder: \"$first_sub
\"! $!";
}

my $second_sub = shift @folders unless $folders[0] =~ m~\.(jpe?g|gif|
png)$~;
$second_sub = $first_sub . '/' . $second_sub if $second_sub;

if ( $second_sub and !-e $second_sub ) {
print "\nNO! Your folder $second_sub does not exists!\n\n";
mkdir $second_sub
or die "could not create your folder: \"$second_sub\"! $!";
}

my $third_sub = shift @folders unless $folders[0] =~ m~\.(jpe?g|gif|
png)$~;
$third_sub = $second_sub . '/' . $third_sub if $third_sub;

if ( $third_sub and !-e $third_sub ) {
print "\nNO! Your folder $third_sub does not exists!\n\n";
mkdir $third_sub or die "could not create your folder: \"$third_sub
\"! $!";
}
 
J

John W. Krahn

Peter said:
BEWARE, UNTESTED PSEUDOCODE
---SNIP---
use strict;
use warnings;

use File::path;
use File::Basename;
use File::Copy;

my @moved=map{s/pix/pix_old/} @filelist;

Now @moved contains a list of either '1' or '' depending of whether
/pix/ matched or not. And all the elements of @filelist have been
modified so that 'pix' is replaced with 'pix_old'.

for(my $i=0;$i<$#filelist;$i++){

You have an off-by-one error. You are iterating through the first
element of @filelist through the second-to-last element of @filelist.

mkpath(dirname($filelist[$i]));
move($filelist[$i],$moved[$i]);
}
---SNIP---

as said, that code is neither tested nor beautiful, but it should give
you an idea on how to start...


John
 
B

Ben Morrow

Quoth Marek said:
I wrote a perl-script to find all unused pix of a web site. Now I
would like to move all those 168! pix from the folder pix to the
folder pix_out keeping the same hierarchy as in the original folder.

168! is approximately 10^302. I'm impressed you have a filesystem with
that many inodes...
That means:

/Users/xxx/Documents/webpages/www.myproject.de/pix/fotos/thumbnails/
tn_munich28.jpg

should be renamed to:

/Users/xxx/Documents/webpages/www.myproject.de/pix_out/fotos/
thumbnails/tn_munich28.jpg

Only one folder is changing his name: pix -> pix_out And this with all
my 168 unused pix in different folders.

I was hoping, that the rename function would create the missing
folders, doing:

rename "/Users/xxx/Documents/webpages/www.myproject.de/pix/fotos/
thumbnails/tn_munich28.jpg", "/Users/xxx/Documents/webpages/
www.myproject.de/pix_out/fotos/thumbnails/tn_munich28.jpg";

No, rename doesn't do that.
But there is even no error message, trying to do it like this with one
test file.

There is no error message because you didn't ask for one. Always check
the return value of system calls.

my $src = "/Users/...";
(my $dst = $src) =~ s,/pix/,/pix_out/,;

rename $src, $dst or die "can't rename $src -> $dst: $!";
So probably I have to grep out the folders starting from "pix"-folder
until the file: this would give in this example the folders fotos ->
thumbnails which are missing and which I have to create in pix_out -
folder

You can use File::Basename or File::Spec to find the directory you are
trying to rename into, and File::path to create the whole directory tree
required in one step.
how to test whether a folder is already created? I tried with:

if (-e ! $dir_pix_out) #wrong!! { mkdir $dir_pix_out; }

Huh? What made you think that would work? Assuming $dir_pix_out contains
a filename, it is a true value. This means ! $die_pix_out is undef, and
you are trying to test for the existance of a file with an empty name.
You will also get a warning: do you have warnings switched on?

The test for a directory is -d, so you want

if (! -d $dir_pix_out) {

or

unless (-d $dor_pix_out) {

Note that mkdir doesn't create multiple levels of directory, either;
again, you need to use File::path.

Ben
 
B

Ben Bullock

Learn to use the right tool for the job. The command line tool move is
perfect for this.

move /Users/xxx/Documents/webpages/www.myproject.de/pix
/Users/xxx/Documents/webpages/www.myproject.de/pix_out

As far as I can understand the original poster has a list of pictures he
wants to move to directories with the name changed in the middle of the
list. What you're suggesting is going to move everything in the
directories, not just the pictures he wants to move.
I am not sure what you mean by this.

Well, why post a reply to a question, if you don't understand it?
Why would there be an error message if you don't ask for it?

Whether there's an error message depends on the detailed behaviour of the
function in question.

Here you need to say

if (!-d $dir_pix_out)
However, testing and creation of the directory is not done in a single
atomic transaction. Therefore, testing the existence of the directory
before attempting to create it is of dubious use.
Really?

Just do

mkdir $dir;

and make sure to check for errors in subsequent file operations because
a directory that existed a few statements back can disappear
once you reach the file operations.

Really? I've never experienced that.
 
A

A. Sinan Unur

As far as I can understand the original poster has a list of
pictures he wants to move to directories with the name changed in
the middle of the list. What you're suggesting is going to move
everything in the directories, not just the pictures he wants to
move.

Well, I understood differently but your explanation makes more
sense.
Well, why post a reply to a question, if you don't understand it?

So that the OP can clarify it if he feels like it.
Whether there's an error message depends on the detailed behaviour
of the function in question.

The caller should check if the function returned an error and
display the error message if necessary. I also showed how to do
that.

IMHO, yes. If the directory already exists, nothing will happen. If
it does not it will created (assuming no permissions issues).

This is the important part. Especially in a scenario which I have
seen occasionally in others' code where the existence of the target
directory is checked before a lengthy loop of file copy operations.
Really? I've never experienced that.

Ahem, I hate to admit it, but I am not sure exactly what I was
thinking of. I seem to remember such a caution but I am not sure
now.

Sinan
--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/
 
T

Tad J McClellan

John W. Krahn said:
Peter Ludikovsky wrote:

You have an off-by-one error. You are iterating through the first
element of @filelist through the second-to-last element of @filelist.


If you had used the standard Perl idiom

foreach my $i ( 0 .. $#filelist ) {

instead of a C-style for(;;) loop, you would have had less
chance of inserting such a bug...

(and whitespace is not a scarce resource, so use some!)
 
T

Tad J McClellan

M

Marek

Sorry to bother this group again! Now my script is nearly finished.
Only one little problem is left: I am imaging the perl "rename" like
the shell "mv". Is there a difference? My rename is not working as
intended:

could not rename your pix from:
/Users/marekstepanek/Documents/webpages/www.munich-taxis.de/
pix/fotos/thumbnails/tn_munich28.jpg
to
/Users/marekstepanek/Documents/webpages/www.munich-taxis.de/
pix_out/fotos/thumbnails/tn_munich28.jpg


Here the last version of my script.


Best greetings


marek


***************



#! /usr/local/bin/perl

use strict;
use warnings;


my $start_dir = "/Users/xyz/Documents/webpages/www.munich-taxis.de";
my $pix_out_folder = "$start_dir/pix_out";
my @unused_pix = (
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/fotos/
thumbnails/tn_munich28.jpg",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp1/
no_n.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
hili_-09.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/
norm_upb.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/
hili_upb.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
hili_-08.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/
norm_dn.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp2/
hili_subchap10.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp2/
hili_db.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp2/
norm_up.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
hili_subchap07.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/
no_fr.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
hili_-11.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
acti_subchap10.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/
rahmen_unten01_10.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp4/
hili_subchap10.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
acti_subchap08.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
hili_up.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp5/
hili_subchap05.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp2/
hili_up.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/
hili_upn.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp2/
norm_tacho_ul_00.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/grafix/chp4/
hili_up.gif",
"/Users/xyz/Documents/webpages/www.munich-taxis.de/pix/fotos/
munich04_03w.jpg"
);

unless ( -d $pix_out_folder ) {
mkdir $pix_out_folder
or die "could not create your folder: $pix_out_folder! $!\n\n";
}



foreach my $pix (@unused_pix) {
my ($path) = $pix =~ m~/pix/([^"]+?)$~;

my @folders = split( "/", $path );

# what happens if there is a deeper hierarchy? So we have to
iterate over
# all elements of @folders

foreach my $sub (@folders)
{
last if $folders[0] =~ m~\.(jpe?g|gif|png)$~;
$sub = shift @folders;
$sub = "$pix_out_folder/$sub";

if ( $sub and !-d $sub ) {
print "\nNO! Your folder \"$sub\" does not exists!\n\n";
mkdir $sub
or die "could <not create your folder: \"$sub\"! $!\n\n";
}
}
}

foreach my $pix (@unused_pix)
{
my $old = $pix;
$pix =~ s~/pix/~/pix_out/~;
my $new = $pix;
rename $old, $new or die "could not rename your pix from:\n\t$old
\nto\n\t$new\n\n $!";
}
 
J

Jürgen Exner

Marek said:
Only one little problem is left: I am imaging the perl "rename" like
the shell "mv". Is there a difference? My rename is not working as
intended:

Did you read the documentation for rename()? I think it is very clear.
could not rename your pix from:
/Users/marekstepanek/Documents/webpages/www.munich-taxis.de/
pix/fotos/thumbnails/tn_munich28.jpg
to
/Users/marekstepanek/Documents/webpages/www.munich-taxis.de/
pix_out/fotos/thumbnails/tn_munich28.jpg

You might want to include the reason _why_ the rename failed. That will
probably give you some hint as to how to fix it.

jue
 
T

Ted Zlatanov

Lawrence said:
You young'ns don't remember the great whitespace shortage of '03
... all the new python people were using all the whitespace that could
be produced -- a lot of programmers had to go mining in old COBOL and
FORTRAN projects of their college days just to get enough whitespace
to keep our variables separated.

Perl, fortunately, was not affected by this shortage by design :)

Ted
 
N

nolo contendere

Sorry to bother this group again! Now my script is nearly finished.
Only one little problem is left: I am imaging the perl "rename" like
the shell "mv". Is there a difference? My rename is not working as
intended:

could not rename your pix from:
        /Users/marekstepanek/Documents/webpages/www.munich-taxis.de/
pix/fotos/thumbnails/tn_munich28.jpg
to
        /Users/marekstepanek/Documents/webpages/www.munich-taxis.de/
pix_out/fotos/thumbnails/tn_munich28.jpg

check out File::Copy::move()
 
D

Dr.Ruud

Ted Zlatanov schreef:
Lawrence Statton wrote:

Perl, fortunately, was not affected by this shortage by design :)

Per 6 is too modern for that:
"Whitespace is in general required between any keyword and any opening
bracket that is not introducing a subscript or function arguments. Any
keyword followed directly by parentheses will be taken as a function
call instead."

sub if { exit 1 }
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

No members online now.

Forum statistics

Threads
473,744
Messages
2,569,484
Members
44,903
Latest member
orderPeak8CBDGummies

Latest Threads

Top