Microsoft Source Server plug-in to index PDB files based on a Mercurial repository.

hg.pl

# ------------------------------------------------------------------------
# hg.pm
#
# Source Server module to handle adding version control information to
# PDB symbol files for source code that is stored in a Mercurial
# repository.
#
# Copyright (c) 2010 ImaginaryRealities, LLC
# ------------------------------------------------------------------------

package HG;

require Exporter;
use strict;
use Cwd 'abs_path';

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless($self, $class);

    $$self{'FILE_LOOKUP_TABLE'} = ();

    return($self);
}

sub GatherFileInformation {
    my $self = shift;
    my $sourcePath = shift;
    my $serverHashReference = shift;

    my $repositoryPath;
    $repositoryPath = $sourcePath . '\';
    while ($repositoryPath) {
        if (defined $$serverHashReference{uc $repositoryPath}) {
            last;
        }

        my $index;
        $repositoryPath = substr($repositoryPath, 0, length($repositoryPath) - 1);
        $index = rindex($repositoryPath, '\');
        if ($index gt 0) {
            $repositoryPath = substr($repositoryPath, 0, $index + 1);
        } else {
            $repositoryPath = "";
        }
    }

    if (!$repositoryPath) {
        ::fatal_error("$sourcePath missing from srcsrv.inin");
    }

    ::info_message("Repository path: $repositoryPath");

    my $repositoryName;
    $repositoryName = $$serverHashReference{uc $repositoryPath};
    ::info_message("Repository name: $repositoryName");

    my $repositoryDir = substr($repositoryPath, 0, length($repositoryPath) - 1);
    my $hProcess;
    my $command = "hg -y -R "$repositoryDir" tip --template "{node}" |";
    ::info_message($command);
    if (!open($hProcess, $command))
    {
        ::warn_message("Unable to get the tip for $sourcePath");
        return();
    }

    my $node;
    $node = <$hProcess>;
    close($hProcess);
    ::info_message("$repositoryPath: $node");

    $_ = abs_path($sourcePath);
    s///\/g;
    $sourcePath = $_;

    $command = "hg -y -R "$repositoryDir" manifest -r $node |";
    ::info_message($command);
    if (!open($hProcess, $command))
    {
        ::warn_message("Unable to get the manifest for node $node and repository $sourcePath");
        return();
    }

    my $path;
    chomp($repositoryName);
    while ($path = <$hProcess>) {
        ::info_message("path = $path");
        $_ = $path;
        s///\/g;
        my $relativePath = $_;
        ::info_message("relative path = $relativePath");
        my $localPath = $repositoryPath . $relativePath;
        ::info_message("local path = $localPath");
        chomp($localPath);
        chomp($path);

        my $hLogProcess;
        $command = "hg -y -R "$repositoryDir" log -r $node:0 "path:$path" --template "{node}\n" |";
        ::info_message($command);
        if (!open($hLogProcess, $command))
        {
            ::warn_message("Unable to get the log for $path");
            return();
        }

        my $fileNode = <$hLogProcess>;
        close($hLogProcess);
        ::info_message("$path = $fileNode");
        chomp($fileNode);

        my $fileEntry = "$localPath*$repositoryName*$path*$fileNode";
        ::info_message($fileEntry);
        @{$$self{'FILE_LOOKUP_TABLE'}{lc $localPath}} = ( { $repositoryName => $repositoryDir }, $fileEntry );
    }

    close($hProcess);

    return(keys %{$$self{'FILE_LOOKUP_TABLE'}} != 0);
}

sub GetFileInfo {
    my $self = shift;
    my $localFile = shift;

    if (defined $$self{'FILE_LOOKUP_TABLE'}{lc $localFile}) {
        return(@{$$self{'FILE_LOOKUP_TABLE'}{lc $localFile}});
    } else {
        return(undef);
    }
}

sub LongName {
    return("Mercurial");
}

sub SourceStreamVariables {
    my $self = shift;
    my @stream;
    push(@stream, "HG_EXTRACT_TARGET=%targ%\%fnbksl%(%var3%)\%var4%\%fnfile%(%var1%)");
    push(@stream, "HG_EXTRACT_CMD=hg -y -R "%fnvar%(%var2%)" cat -r %var4% "path:%var3%" > "%hg_extract_target%"");
    return (@stream);
}