view release on metacpan or  search on metacpan

lib/CTK/Skel/Extra.pm  view on Meta::CPAN

This is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

%PODSIG%cut

use vars qw/$VERSION @EXPORT/;
$VERSION = '1.02';

use Carp;
use File::Copy qw/cp/;
use File::Find;
use File::Spec;
use Cwd qw/getcwd/;
my $basedir = getcwd();

use base qw/Exporter/;
@EXPORT = qw/configure install/;

sub configure {
    my @srcs = @ARGV;
    my $dst = pop @srcs;
    croak "Source directories missing!" unless @srcs;
    croak "Target directory missing!" unless $dst;
    $dst = File::Spec->catdir($basedir, $dst) unless File::Spec->file_name_is_absolute($dst);

    foreach my $src (@srcs) {
        chdir($src) or do {
            print STDERR "Can't change directory: $!\n";
            return 0;
        };
        find({ wanted => sub {
            return if /^\.exists$/;
            my $dir = $File::Find::dir;
            if (-f $_) {
                my $src_f = $_;
                my $dst_f = File::Spec->catfile($dst, $dir, $src_f);
                printf "Copying file %s --> %s... ", $src_f, $dst_f;
                if (-e $dst_f) {
                    print "skipped. File already exists\n";
                    return;
                }
                cp($src_f, $dst_f) or do {
                    print "failed\n";
                    print STDERR "Can't create $dst_f: $!\n";
                };
                print "ok\n";
            } elsif (-d $_) {
                return if /^\.+$/;
                my $dst_d = File::Spec->catdir($dst, $dir, $_);
                my $perm = 0755 & 07777;
                print sprintf("Creating directory %s... ", $dst_d);
                if (-e $dst_d) {
                    print "skipped. Directory already exists\n";
                    return;
                }
                mkdir($dst_d) or do {
                    print "failed\n";
                    print STDERR "Can't create $dst_d: $!\n";
                };
                eval { chmod $perm, $dst_d; };
                if ($@) {
                    print STDERR $@, "\n";
                }
                print "ok\n";
            } else {
                print "Skipped: $_\n";
            }
        }}, ".");
        chdir($basedir) or do {
            print STDERR "Can't change directory: $!\n";
            return 0;
        }
    }

    return 1;
}
sub install { goto &configure }

1;
-----END FILE-----