Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re^2: Wildcards for a wide array of strings?

by mr_mischief (Monsignor)
on May 24, 2017 at 00:30 UTC ( #1191032=note: print w/replies, xml ) Need Help??


in reply to Re: Wildcards for a wide array of strings?
in thread Wildcards for a wide array of strings?

I used local paths and coding was done on a Unix-type system (MacOS in this case), so adjust paths and separators accordingly. Optionally, use the core module File::Spec and let it worry about the path separators. I present a few versions here.

Each version adds an important check that you're not moving all your files one after the other into a single file (leaving just the contents of the last source file).

In many cases you could skip using File::Copy and just use rename but then you may have to handle some edge cases yourself that the module handles for you. I'd recommend using the module.

You definitely don't need to take a glob of all files, then in a loop glob all files ending in '.txt' again. You can use glob to get the list (in list context) of just the files you want and iterate over that. The code below does not do what you seem to expect.:

if ($file = glob(($base)."*.txt")){ # ... }

That is assigning the first match from glob(($base)."*.txt") to $file after you've already set $file as the loop variable. So for every file that matches glob($base/"*") you're re-globbing for "$base*.txt" using a fresh iterator internal to the perl runtime and operating on that filename that's returned in scalar context. Don't do that. Just get the right list the first time and operate on each member of that list in turn.

Here's code with hard-coded paths in Unix path form to where I was working with the files.:

#!/usr/bin/perl use strict; use warnings; use File::Copy (); my $base = '/Volumes/case-sensitive/projects/monks/1190936'; my @time = (localtime)[ 5, 4, 3 ]; $time[0] += 1900; $time[1]++; my $dir_for_today = sprintf '%s/%04d/%02d/%02d', $base, @time; die "destination $dir_for_today is not a directory!\n" unless -d $dir_ +for_today; foreach my $file ( glob qq($base/*.txt) ) { File::Copy::move $file, $dir_for_today or warn "Can't move $file + to $dir_for_today : $!"; }

Here's equivalent code using File::Spec to worry about the path separator. :

#!/usr/bin/perl use strict; use warnings; use File::Copy (); use File::Spec; my $volume = ''; # empty string for Unix my @dirs = ( File::Spec->rootdir, 'Volumes', 'case-sensitive', 'projec +ts', 'monks', '1190936' ); my $base = File::Spec->catpath( $volume, File::Spec->catdir( @dirs ), +'' ); my @time = (localtime)[ 5, 4, 3 ]; $time[0] += 1900; $time[1]++; $time[1] = sprintf '%02d', $time[1]; $time[2] = sprintf '%02d', $time[2]; my $dir_for_today = File::Spec->catdir( $base, @time ); die "destination $dir_for_today is not a directory!\n" unless -d $dir_ +for_today; foreach my $file ( glob File::Spec->catfile( $base, '*.txt' ) ) { File::Copy::move $file, $dir_for_today or warn "Can't move $file + to $dir_for_today : $!"; }

For your path, according to your example I think you'd want 'D' for your volume, and of course you'd want 'Some', 'specific', 'folder' in your @dirs array according to your example.

A couple more are below...

If you want it a little more configurable and to control the source directory (and possibly the destination directory) from your cron / scheduled tasks / Powershell / Bash command line rather than hardcoding such things into the program, and also want to break it up a bit into functions with fewer global variables, you could use Getopt::Long and do something like this.:

#!/usr/bin/perl use strict; use warnings; use File::Copy (); use File::Spec; use Getopt::Long (); my %config = ( 'source' => '.', 'destination' => undef, 'extension' => '.txt', ); Getopt::Long::GetOptions( \%config, 'source=s', 'destination=s', 'exte +nsion=s' ); sub day_dir { my @time = (localtime)[ 5, 4, 3 ]; $time[0] += 1900; $time[1]++; $time[1] = sprintf '%02d', $time[1]; $time[2] = sprintf '%02d', $time[2]; return File::Spec->catdir( @time ); } sub source { my $c = shift; return $c->{ 'source' }; } sub destination { my $c = shift; my $d = undef; if ( ! defined $c->{ 'destination' } ) { $d = File::Spec->catdir( $c->{ 'source' }, day_dir() ); } else { $d = $c->{ 'destination' }; } return $d; } sub extension { my $c = shift; return $c->{ 'extension' }; } my $destination = destination( \%config ); die "destination $destination is not a directory!\n" unless -d $destin +ation; foreach my $file ( glob File::Spec->catfile( source( \%config ), '*' . + extension( \%config ) ) ) { File::Copy::move $file, $destination or warn "Can't move $file t +o $destination : $!"; }

Or if you don't like having a global hash passed around to a bunch of functions, you can go OO and instantiate one object that contains all that state and use methods. You can even do that thing all the JavaScript libraries seem to love, chaining some of the method calls (since some methods return the object reference itself). :

#!/usr/bin/perl use strict; use warnings; package Mover; use File::Copy (); use File::Spec; use Getopt::Long (); sub new { my $class = shift; my $self = { 'source' => '.', 'destination' => undef, 'extension' => '.txt', 'day_dir' => undef, 'warnings' => [], }; Getopt::Long::GetOptions( $self, 'source=s', 'destination=s', 'ext +ension=s' ); return bless $self, $class; } sub day_dir { my $self = shift; if ( ! defined $self->{ 'day_dir' } ) { my @time = (localtime)[ 5, 4, 3 ]; $time[0] += 1900; $time[1]++; $time[1] = sprintf '%02d', $time[1]; $time[2] = sprintf '%02d', $time[2]; $self->{ 'day_dir' } = File::Spec->catdir( @time ); } return $self->{ 'day_dir' }; } sub source { my $self = shift; return $self->{ 'source' }; } sub destination { my $self = shift; if ( ! defined $self->{ 'destination' } ) { $self->{'destination'} = File::Spec->catdir( $self->{ 'source' + }, $self->day_dir() ); } return $self->{'destination'}; } sub extension { my $self = shift; return $self->{ 'extension' }; } sub move { my $self = shift; if ( -d $self->destination() ) { foreach my $file ( glob File::Spec->catfile( $self->source(), +'*' . $self->extension() ) ) { File::Copy::move $file, $self->destination() or $self->w +arn( "Can't move $file to " . $self->destination() . " : $!\n" ); } } else { $self->warn( $self->destination . " is not a directory!\n" ); } return $self; } sub warn { my ( $self, $warning ) = @_; push @{ $self->{ 'warnings' } }, $warning; return $self; } sub warnings { my $self = shift; return join "\n", @{ $self->{ 'warnings' } }; } 1; package main; print STDERR Mover->new()->move()->warnings();

This last one even collects all the warnings into the object itself and lets the caller figure out what to do with the data.

So yeah, there are plenty of ways to accomplish this. This is but a pittance. Someone from here might suggest a modulino. Someone else may criticize using accessors in the OO version. Someone might suggest leaving the loop from the move method in the calling program. Software is flexible, programming languages are more so, and Perl more so than many programming languages. I hesitate to show it here, but this could also be done handily in a Perl (or Bash, or probably PowerShell) one-liner.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1191032]
help
Chatterbox?
[mr_mischief]: I remember buying retail a RedHat Linux 5.2 book with CD, and later a Mandrake 7 or 8 box set with all the commercial-only add-ons. Same thing with Caldera 2.3, cardboard box and all. These days I can mirror whole repos faster than that trip to the store.
[erix]: yeah. it's been some time since I last built a (linux) kernel but perl takes less than 30s and postgresql less than 2 minutes minutes :)
[talexb]: Yep .. came across SuSE 6.2 in my storage locker recently. How old is that.
[erix]: 2001 :)
[erix]: (I have the wp pages open :))

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (9)
As of 2018-07-17 17:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (374 votes). Check out past polls.

    Notices?