view release on metacpan or  search on metacpan

lib/Test/Smoke/Syncer/Base.pm  view on Meta::CPAN

=head2 Test::Smoke::Syncer::Baase->new(%arguments)

Return a new instance.

=cut

sub new {
    my $class = shift;

    return bless {@_}, $class;
}

=head2 $syncer->verbose

Get/Set verbosity.

=cut

sub verbose {
    my $self = shift;
    $self->{v} = shift if @_;
    return $self->{v};
}

=head2 $syncer->sync()

Abstract method.

=cut

sub sync {
    my $self = shift;
    my $class = ref $self || $self;
    Carp::croak("Should have been implemented by '$class'");
}

=head2 $syncer->_clear_souce_tree( [$tree_dir] )

[ Method | private-ish ]

C<_clear_source_tree()> removes B<all> files in the source-tree
using B<File::Path::rmtree()>. (See L<File::Path> for caveats.)

If C<$tree_dir> is not specified, C<< $self->{ddir} >> is used.

=cut

sub _clear_source_tree {
    my( $self, $tree_dir ) = @_;

    $tree_dir ||= $self->{ddir};

    $self->log_info("Clear source-tree from '$tree_dir' ");
    my $cnt = File::Path::rmtree( $tree_dir, $self->{v} > 1 );

    File::Path::mkpath( $tree_dir, $self->{v} > 1 ) unless -d $tree_dir;
    $self->log_info("clear-source-tree: $cnt items OK");

}

=head2 $syncer->_relocate_tree( $source_dir )

[ Method | Private-ish ]

C<_relocate_tree()> uses B<File::Copy::move()> to move the source-tree
from C<< $source_dir >> to its destination (C<< $self->{ddir} >>).

=cut

sub _relocate_tree {
    my( $self, $source_dir ) = @_;

    require File::Copy;

    $self->{v} and print "relocate source-tree ";

    # try to move it at once (sort of a rename)
    my $ddir = $^O eq 'VMS' ? $self->{vms_ddir} : $self->{ddir};
    my $ok = $source_dir eq $ddir
           ? 1 : File::Copy::move( $source_dir, $self->{ddir} );

    # Failing that: Copy-By-File :-(
    if ( ! $ok && -d $source_dir ) {
        my $cwd = cwd();
        chdir $source_dir or do {
            print "Cannot chdir($source_dir): $!\n";
            return 0;
        };
        require File::Find;
        File::Find::finddepth( sub {

            my $dest = File::Spec->canonpath( $File::Find::name );
            $dest =~ s/^\Q$source_dir//;
            $dest = File::Spec->catfile( $self->{ddir}, $dest );

            $self->{v} > 1 and print "move $_ $dest\n";
            File::Copy::move( $_, $dest );
        }, "./" );
        chdir $cwd or print "Cannot chdir($cwd) back: $!\n";
        File::Path::rmtree( $source_dir, $self->{v} > 1 );
        $ok = ! -d $source_dir;
    }
    die "Can't move '$source_dir' to $self->{ddir}' ($!)" unless $ok;
    $self->{v} and print "OK\n";
}

=head2 $syncer->check_dot_git_patch( )

[ Method | Public ]

C<check_dot_git_patch()> checks if there is a '.git_patch' file in the source-tree.

It returns the patchlevel found or C<undef>.

=cut

sub check_dot_git_patch {
    my $self = shift;

    my $dot_git_patch = File::Spec->catfile( $self->{ddir}, '.git_patch' );

    local *DOTGITPATCH;
    my $patch_level = '?????';
    if ( open DOTGITPATCH, "< $dot_git_patch" ) {
        chomp( $patch_level = <DOTGITPATCH> );
        close DOTGITPATCH;

	if ( $patch_level ) {

	    return undef if ( $patch_level =~ /^\$Format/ ); # Not expanded

            my @dot_git_patch = split '\|', $patch_level;

            # As we do not use time information, we can just pick the first and
            # the last two elements