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;