view release on metacpan or  search on metacpan

bin/slaughter  view on Meta::CPAN

            my $guess = File::Spec->catfile( $dir, "Slaughter", "Transport" );

            #
            #  Found the module directory?
            #
            if ( -d $guess )
            {
                foreach my $pm ( sort( glob( $guess . "/*.pm" ) ) )
                {

                    # skip the base-class
                    next if ( $pm =~ /revisionControl\.pm/ );

                    # strip the directory name + suffix
                    my $name = basename($pm);
                    $name =~ s/\.pm$//gi;

                    print $name . "\n";
                }
            }
        }
        exit;
    }

}


=begin doc

Create a lockfile, which will be removed on process-termination.

=end doc

=cut

sub createLock
{

    #
    #  Get the lockfile - if we failed to define one then abort.
    #
    my $lockfile = $CONFIG{ 'lockfile' };
    return unless ($lockfile);


    #
    # Open the lock-file exclusively.
    #
    open( LOCK, ">>", $lockfile ) or
      die "Failed to open lockfile at $lockfile - $!";

    #
    # Lock the file.
    #
    flock( LOCK, LOCK_EX | LOCK_NB ) or
      die "$0 already running - Lock file $lockfile is locked";


    #
    # The file will be closed when slaughter terminates so although it
    # looks like we're leaking a handle here this is intentional.
    #

}

=begin doc

Create a temporary directory for holding files, some transports need this.

B<NOTE>:  This directory will be removed when this process terminates unless
slaughter was invoked with --no-delete.

=end doc

=cut

sub createTransportDir
{

    #
    #  Temporary directory for transports to use
    #
    $CONFIG{ 'transportDir' } = tempdir( CLEANUP => !$CONFIG{ 'nodelete' } );

    #  The temporary directory should not be world-readable
    chmod 0700, $CONFIG{ 'transportDir' };
}



=begin doc

Test the environment - which is a combination of the command line flags, and
configuration file settings, and the local user.

=end doc

=cut

sub testEnvironment
{
    if ( $UID != 0 and !$CONFIG{ 'allownonroot' } )
    {
        print <<EOF;
You must launch this command as root.
EOF
        exit 1;
    }

    #
    #  If we have no transport type, but we do have a prefix, we can attempt
    # to infer what to use.
    #
    if ( $CONFIG{ 'prefix' } && !$CONFIG{ 'transport' } )
    {

        # show what is going on
        $CONFIG{ 'verbose' } &&
          print "Attempting to guesss transport for $CONFIG{'prefix'}\n";

        # git://.... or   http://.../foo.git