Modules.pm #1

package P4::Modules;
# TODO:
#   No guard againt circular dependencies but they shouldn't happen.

=head1 NAME

P4::Modules - map groups of directories out of the depot by name

=head1 SYNOPSIS

    use P4::Modules;
    $mod = P4::Modules->new();  # Use /etc/p4tools/modules.conf
    $mod = P4::Modules->new($modules_file);

    # $module may be blank (to indicate all modules).
    %clientmap = $mod->client($default, $modules, $client);

    %branchmap = $mod->branch($default, $modules, $branch);


    # Given a branch name and a client side relative path (eg /x/y.txt),
    # return the location in the depot.
    $depotpath = $mod->where($branch, $path);


=head1 DESCRIPTION

    ...

=cut

use strict;

BEGIN {
    use Exporter        ();
    use vars            qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    $VERSION          = 0.94;
    @ISA              = qw(Exporter);
    @EXPORT           = ();
    @EXPORT_OK        = ();
}

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $file = shift || '/etc/p4tools/modules.conf';

    %P4::Modules::DEPENDENCIES = ();
    %P4::Modules::LOCATIONS = ();
    require $file;

    bless {
        dependencies => {%P4::Modules::DEPENDENCIES},
        locations    => {%P4::Modules::LOCATIONS},
        reverses     => _make_reverses(\%P4::Modules::LOCATIONS)
    }, $class;
}

sub client {
    my ($self, $default, $modules, $client) = @_;
    my %modules = $self->_expand_modules($default, $modules);
    my %map = ();
    for my $module (keys %modules) {
        my $mref = $self->{locations}->{$module};
        for my $path (keys %$mref) {
            my $d = $path;
            $d =~ s/\@B@/$modules{$module}/g;
            $map{$d} = "//$client$$mref{$path}";
        }
    }
    %map;
}

sub branch {
    my ($self, $default, $modules, $branch) = @_;
    my %modules = $self->_expand_modules($default, $modules);
    my %map = ();
    for my $module (keys %modules) {
        my $mref = $self->{locations}->{$module};
        for my $path (keys %$mref) {
            my ($d, $d2) = ($path, $path);
            $d =~ s/\@B@/$modules{$module}/g;
            $d2 =~ s/\@B@/$branch/g;
            $map{$d} = $d2;
        }
    }
    %map;
}

sub where {
    my ($self, $branch, $path) = @_;
    my $revs = $self->{reverses};
    my $depotpath = undef;
    $path = "/$path" unless $path =~ m|^/|;
    if ($revs->{$path}) {
        $depotpath = $revs->{$path};
    } else {
        my ($dir, $file) = ($path, '');
        while ($dir) {
            ($dir, $file) = ($dir =~ m|(.*)/(.*)|);
            ($file = $path) =~ s|\Q$dir\E||;
            if ($revs->{$dir . '/...'}) {
                ($depotpath = $revs->{$dir . '/...'}) =~ s|/\.\.\.$||;
                $depotpath .= "$file";
                last;
            }
        }
    }
    $depotpath =~ s/\@B@/$branch/g if $depotpath;
    return $depotpath;
}

sub _expand_modules {
    my ($self, $default, $modules) = @_;
    my %mods = ();
    my %final = ();

    unless ($modules) {
        $modules = join(" ", keys %{$self->{locations}});
    }
    for (split /\s+/, $modules) {
        my ($m, $v) = split /:/;
        $self->_add_module(\%mods, $m, $v || $default, 0);
    }
    
    for (keys %mods) {
        my $ref = $mods{$_};
        my ($ver) = sort { $ref->{$a} <=> $ref->{$b} } keys %$ref;
        $final{$_} = $ver;
    }
    %final;
}

sub _add_module {
    my ($self, $mods, $m, $v, $dist) = @_;

    if (exists($mods->{$m}->{$v})) {
        my $odist = $mods->{$m}->{$v};
        $dist = $dist < $odist ? $dist : $odist;
    }
    $mods->{$m}->{$v} = $dist;

    for ($self->_depends($m)) {
        $self->_add_module($mods, $_, $v, $dist+1);
    }
}

sub _depends {
    my ($self, $m) = @_;
    my $ref = $self->{dependencies}->{$m} || [];
    @$ref;
}

sub _make_reverses {
    my ($href) = @_;
    my %revs = ();
    my %seen = ();

    for my $mod (keys %$href) {
        while (my ($depot, $client) = each %{$href->{$mod}}) {
            if ($revs{$client} && $revs{$client} ne $depot) {
                warn "$client mapped somewhere else by $seen{$client}\n";
            }
            $revs{$client} = $depot;
            $seen{$client} = $mod;
        }
    }
    \%revs;
}

1;