Perl webcode deploy script - perl

I am creating a Perl script to deploy webcode (Windows 2008 Server). I need to first Copy all of the old files from the destination folder and create an archive dir for the files with a timestamp trailing on the archive dir name (arc_dir.20131217). Move the files into the archive. Then I need to copy the code from the source dir into the destination folder. However it is not working at all and I am absolutely clueless as to why.
Two things, I am very green with Perl as will be shortly seen and I do not want someone to do the code for me. It kind of defeats the purpose of learning. Direction and a dialogue would be great. I am a veterans dream, willing to learn and I desire to write only clean code.
use strict;
use warnings;
use autodie;
use File::Copy; #Gives you access to the "move" command
use File::Path; #Copies data recursively from one dir and creates a new dir
use POSIX;
#Set Directories
use constant {
TIMESTAMP => strftime("%Y%M%d%H%M%S", localtime);
Source_Dir => "C:\Users\Documents\Source_Dir",
destination_Dir => "C:\Users\Documents\Destination_Dir",
ARCHIVE => "C:\Users\Documents\arc_dir.TIMESTAMP",
};
#Creates new directory to archive old files
make_path('C:\Users\Shaun\Documents\arc_dir.TIMESTAMP');
#Need to copy destination dir, create archive dir and paste data to it
#Opens destination_Dir, so I can read from it
opendir my $dir, destination_Dir;
# Loop through directory and grab all of the files and store in var
while (my $file = readdir $dir) {
my $destination_Dir = destination_Dir . "/" . "$file";
move $destination_Dir, ARCHIVE;
#Loop through directory and copy all webcode to destination_Dir
opendir my $dir, Source_Dir;
while (my $file = readdir $dir) {
my $Source_Dir = Source_Dir . "/" . "$file";
move $Source_Dir, destination_Dir;

There are some syntax errors in the script. I would use the -c on the command line to the PERL to check the syntax of the script (such as perl -c ). Please make sure your () and {} are matched.
The other item is that backwards slash (\) need to be escaped with a backward slash (\) when in double quotes ("). Otherwise it is just escaping the next character in the string (and is probably not what you want for a path name). Strings in double quotes are interpolated before being processed, where single quotes are not (Nice explanation of the difference between sinqle quotes and doubles: http://www.perlmonks.org/?node_id=401006). You may want to change the sinqle quotes you have to double quotes in your makepath call. Otherwise TIMESTAMP will not be changed and the directory will have the name TIMESTAMP.
I would also suggest putting in some print statement to indicate what is being done and to give feedback that items are progressing. Such as printing the "moving $destination_Dir to ARCHIVE" and "moving $Source_Dir to destination_Dir" would let you know files are being moved.

Related

batch rename files that start with '-'?

I usually get a bunch of files whose name start with a dash '-' . This is causing all sorts of problem when i do any kind of linux commands because anything after - is interpreted as a flag.
What is the fastest way to rename these files without dash character in the front of the file. I can manually rename each file by adding a '--' in front of the file name.For eg: '-File1' will be renamed as
mv -- -File1 File1
But this is not ideal when i have to rename 100's of files on the fly. Currently I have to export it out and use a windows program so I can batch rename them and then upload it back to a Linux box.
The easiest way to refer to such a file is ./-File1. (You only have the problem if the file is in the current directory, anyway.) Maybe if you get used to that it's not so bad.
To bulk rename them, you could do something like:
for f in -*; do mv "./$f" "renamed$f"; done
or, as #shellter suggests in a comment, to reproduce the example in the OP:
for f in -*; do mv "./$f" "${f#-}"; done
Note: the above will only remove a single - from the name.
If you have the util-linux package (most do?):
rename - '' ./-*
man rename
Might be easier to do this in the shell, but if you're worried about special cases or if you would just rather use perl there's a couple ways to do it. One is to use File::Copy mv:
use strict;
use warnings;
use File::Copy qw(mv);
opendir(my $dir, ".") or die "Can't open $!";
foreach my $file (readdir($dir)) {
my $new_name = $file =~ s/^-+//r; #works if filename begins with multiple '-'s
if ($new_name ne $file) {
say "$file -> $new_name";
mv $file, $new_name;
}
}
or use the rename builtin, but this theoretically can not work for some system implementations:
rename $file, $new_name; #instead of mv $file, $new_name;
In either case, if a file with the new name exists it will get silently overwritten with this code. You might need some logic to take care of that:
# Stick inside the "if" clause above
if (-e $new_name) {
say "$new_name already exists!"
next;
}
Using find:
find -name '-*' -exec rename -- - '' {} \;

Perl Archive::Zip creates unnecessary folders

Assuming I have the following array of file names I wish to zip
my #files = ("C:\Windows\Perl\test1.txt", "C:\Windows\Perl\test2.txt", "C:\Windows\Perl\test3.txt");
If I do
$obj = Archive::Zip->new();
foreach (#files)
{
$obj->addFile($_);
}
$obj->writeToFileNamed("zippedFolders.zip");
When I open zippedFolders.zip I see it contains subfolders, namely Windows and Perl, the latter which actually contains test1, test2, and test3. For some reason, the folders themselves are getting zipped up.
How can I make it so that only the files get zipped up and not have to click Windows then Perl folders to access the zipped files?
As you have see, if you use addFile to add a disk file to an archive, then Archive::Zip adds an archive member with the same path as file had originally. If you want it stored as something different then you can pass a second parameter that will be used as the name and path of the archive member created.
For your purposes I suggest you use the core File::Basename module to remove the path from the filename and pass just the basename as the second parameter.
The code below demonstrates.
Something else you need to be aware of is that you can't use single backslashes in Perl double quotes - they will be seen as escaping the following character and simply disappear. You can use pairs of backslashes in the string, use single quotes instead, use forward slashes instead (Perl will sort things out) or if there are no spaces in the filenames then you can use qw() as I have in this program.
use strict;
use warnings;
use Archive::Zip;
use File::Basename 'basename';
my #files = qw/
C:\Windows\Perl\test1.txt
C:\Windows\Perl\test2.txt
C:\Windows\Perl\test3.txt
/;
my $zip = Archive::Zip->new;
foreach my $file (#files) {
my $member = basename $file;
printf qq{Adding file "%s" as archive member "%s"\n}, $file, $member;
$zip->addFile($file, $member);
}
$zip->writeToFileNamed('zippedFolders.zip');
output
Adding file "C:\Windows\Perl\test1.txt" as archive member "test1.txt"
Adding file "C:\Windows\Perl\test2.txt" as archive member "test2.txt"
Adding file "C:\Windows\Perl\test3.txt" as archive member "test3.txt"

How to recursively copy with wildcards in perl?

I've modified some script that I've written to now only copy .jpg files.
The script seems to work. It will copy all of the .jpg files from one folder to another but the script is meant to continually loop every X amount of seconds.
If I add a new .jpg file to the folder I'm moving items from after I have already started the script it will not copy over the newly added file. If I stop and restart the script then it will copy the new .jpg file that was added but I want the script to copy items as they are put into the folders and not have to stop and restart the script.
Before I added the glob function trying to only copy .jpg files the script would copy anything in the folder even if it was moved into the folder while the script was still running.
Why is this happening? Any help would be awesome.
Here is my code:
use File::Copy;
use File::Find;
my #source = glob ("C:/sorce/*.jpg");
my $target = q{C:/target};
while (1)
{ sleep (10);
find(
sub {
if (-f) {
print "$File::Find::name -> $target";
copy($File::Find::name, $target)
or die(q{copy failed:} . $!);
}
},
#source
);
}
Your #source array contains a list of file names. It should contain a list of folders to start your search in. So simply change it to:
my $source = "C:/source";
I changed it to a scalar, because it only holds one value. If you want to add more directories at a later point, an array can be used instead. Also, of course, why mix a glob and File::Find? It makes little sense, as File::Find is recursive.
The file checking is then done in the wanted subroutine:
if (-f && /\.jpg$/i)
It won't refresh its list of files if you only glob the list once.
I prefer to use File::Find::Rule, and would use that for each iteration on the directory instead to update the list.
use File::Find::Rule;
my $source_dir = 'C:/source';
my $target_dir = 'C:/target';
while (1) {
sleep 10;
my #files = File::Find::Rule->file()
->name( '*.jpg' )
->in( $source_dir );
for my $file (#files) {
copy $file, $target
or die "Copy failed on $file: $!";
}
}

Moving files into different folders/directories based on their name

I have a directory or folder consisting of hundreds of files. They are named and arranged alphabatically. I want to move the files into directories or folders according to the first character of their name (i.e. files starting with a into one folder, files starting with r into another folder, etc).
Is there a way to do it without using CPAN modules?
Are the files all in that one folder, or are they in subfolders? If they are all in a single folder, you can use opendir to access the directory, and then readdir to read the file names and copy them elsewhere (using File::Copy module's move or copy function.
use strict;
use warnings;
use autodie;
use File::Copy; #Gives you access to the "move" command
use constant {
FROM_DIR => "the.directory.you.want.to.read",
TO_DIR => "the.directory.you want.to.move.the.files.to",
};
#Opens FROM_DIR, ao I can read from it
opendir my $dir, FROM_DIR;
# Loopa through the directory
while (my $file = readdir $dir) {
next if ($file eq "." or $file eq "..");
my $from = FROM_DIR . "/" . "$file";
move $from, TO_DIR;
}
This doesn't do exactly what you want, but it should give you the idea. Basically, I'm using opendir and readdir to read the files in the directory and I'm using move to move them to another directory.
I used the File::Copy module, but this is included in all Perl distributions, so it's not a CPAN module that must be installed.
Use glob(), or the built-in File::Find to build a list of files for each starting letter.

Redirect unzip output to particular directory using Perl

I want to uncompress zipped file say, files.zip, to a directory that is different from my working directory.
Say, my working directory is /home/user/address and I want to unzip files in /home/user/name.
I am trying to do it as follows
#!/usr/bin/perl
use strict;
use warnings;
my $files= "/home/user/name/files.zip"; #location of zip file
my $wd = "/home/user/address" #working directory
my $newdir= "/home/user/name"; #directory where files need to be extracted
my $dir = `cd $newdir`;
my #result = `unzip $files`;
But when run the above from my working directory, all the files get unzipped in working directory. How do I redirect the uncompressed files to $newdir?
unzip $files -d $newdir
Use Perl command
chdir $newdir;
and not the backticks
`cd $newdir`
which will just start a new shell, change the directory in that shell, and then exit.
Though for this example, the -d option to unzip is probably the simplest way to do what you want (as mentioned by ennuikiller), for other types of directory-changing, I like the File::chdir module, which allows you to localize directory changes, when combined with the perl "local" operator:
#!/usr/bin/perl
use strict;
use warnings;
use File::chdir;
my $files= "/home/user/name/files.zip"; #location of zip file
my $wd = "/home/user/address" #working directory
my $newdir= "/home/user/name"; #directory where files need to be extracted
# doesn't work, since cd is inside a subshell: my $dir = `cd $newdir`;
{
local $CWD = $newdir;
# Within this block, the current working directory is $newdir
my #result = `unzip $files`;
}
# here the current working directory is back to what it was before
You can also use the Archive::Zip module. Look specifically at the extractToFileNamed:
"extractToFileNamed( $fileName )
Extract me to a file with the given name. The file will be created with default modes. Directories will be created as needed. The $fileName argument should be a valid file name on your file system. Returns AZ_OK on success. "