Here is my little tool to "move shapes" coded in Perl. If more "sidecar files" show up, append them to the line.
# Shape file extention candidates + so called side car files
my @ext = qw(shp shx dbf prj sbn sbx fbn fbx atx ixs mxs cpg);
May be it is a little bit noisy in terms of output.
#!/usr/bin/env perl
# ------------------------------------------------------------
# shpmv -- Tool to rename ESRI Shape files
# ------------------------------------------------------------
# Copyright (C) 2016 Alexander Weidauer
# Contact: alex.weidauer@huckfinn.de
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# ------------------------------------------------------------
use strict;
use File::Copy qw(move);
use File::Basename;
use File::Spec;
Read command line parameter $1 $2 and $3
my $src = shift; # Source location
my $dst = shift; # Destination
my $case = shift; # Extention handling upper or lower case
Parameter handling and help function
if ( ($src eq '-h') or ($src eq '--help') ) {
print "Move ESRI Shape files\n\n";
print "Usage: $0 source-file destination [-l|-u]\n";
print "Parameter:\n";
print " source-file -- Shapefile for the ensemble to move from.\n";
print " destination -- Shapefile destination without extension to move to.\n\n";
print "Optional:\n";
print " -l extention lower case\n";
print " -u extention upper case\n\n";
print "Example: $0 ~/geodata/long_name.shp ~/data/short_name\n";
exit 0;
}
Shape file extention candidates + so called side car files
my @ext = qw(shp shx dbf prj sbn sbx fbn fbx atx ixs mxs cpg);
Check parameter correctness and availability
die "Missing source Shapefile\n" if ! $src;
die "Missing destination name\n" if ! $dst;
Lower case is the default switch
$case //= '-l';
Make path an file management absolute
$src = File::Spec->rel2abs($src);
$dst = File::Spec->rel2abs($dst);
Strip the extention from the input and
check source and destination path
my ($sname, $spath, $suffix) = fileparse($src, '.[^\.]*');
$src = File::Spec->catfile($spath,$sname);
die "Source '$spath' path does not exist!\n" if ! (-d $spath);
if ( ($dst =~ /.shp$/) or ($dst =~ /.SHP$/) ) {
print "WARNING remove extention from destiantion '$dst'\n";
$dst =~ s/.shp$//;
$dst =~ s/.SHP$//;
}
my ($dname, $dpath, $duffix) = fileparse($dst, '.[^\.]*');
die "Destination path '$dpath' does not exist\n"
if not -d $dpath;
print "Move ESRI shape files\n";
print " from: $src\n";
print " to: $dst\n";
Check files to move
my @suffix=();
for my $ix (0..$#ext) {
my $lext = $ext[$ix];
my $uext = uc($lext);
my $lname = $src.'.'.$lext;
my $uname = $src.'.'.$uext;
my $done = 0;
print " ..test $sname(".$lext."|".$uext.")";
if (-r $lname) {
push (@suffix, $lext) if (-e $lname);
$done = 1;
}
if (-r $uname) {
push (@suffix, $uext) if (-e $uname);
$done = 1;
}
if (! $done) {
print " N/A\n";
die "Cannot read one of the essential shape ".
"files with extension $lext|$uext\n" if $ix < 3;
} else {
print " OK\n" if $done;
}
}
Proceed move operation
for my $sext (@suffix) {
my $text = $sext;
$text = lc($text) if $case eq '-l';
$text = uc($text) if $case eq '-u';
my $sfile = $src.".".$sext;
my $tfile = $dst.".".$text;
print " ..move from: $sfile\n";
print " to: $tfile";
move($sfile, $tfile) or die "\nCannot move file $sfile!\n";
print " OK\n";
}
print ".READY\n";
--- EOF ----------------------------------------------------
