stcom.pm #6

# $Id: //guest/jeffery_g_smith/perforce/utils/sttop4/main/stcom.pm#6 $
#
# StarTeam to Perforce Converter, StarTeam automation interface
#
# Copyright 2004-2005 Perforce Software/MedPlus, Inc.  All rights reserved.
#   Jeffery G. Smith, MedPlus, Inc. 2004-2005

require 5.0;
package stcom;

use strict;
use Win32::OLE;
use Win32::OLE::Variant;
use convert;

use vars qw(@ISA @EXPORT);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw ( StarTeamSDKinit StarTeamSDKdone STgetproject STgetview
               STgetrootfolder STgetfilelist STgetsubfolders STgethistory
               STgetname STgetnext STgetfileref STgetfilepathname STgetfiletype
               STgetfilesize STgetfilever STgetfiledate STgetfilecomment);

my ($stserver, $stobj);

sub StarTeamSDKinit
{
    $stobj = Win32::OLE->new($convert::st_progid);
    $stobj || OLEexit("Unable to initialize StarTeam COM interface");
    $stserver = OLEcall($stobj,'Create',$convert::st_server,$convert::st_port);
    OLEcall($stserver,'logOn',$convert::st_user,$convert::st_passwd);
}

sub StarTeamSDKdone
{
    OLEexit();
}

sub STgetfileref
{
    my ($filepathname) = @_;
    my ($project, @path) = split(/\//,$filepathname);
    my $file = join("\\",@path);
    my $pref = STgetproject($project);
}

sub STgetproject
{
    my ($name) = @_;
    
    my $projects = OLEget($stserver, 'Projects');
    foreach my $project (in $projects)
    {
        return $project if (STgetname($project) eq $name);
    }
    
    OLEexit("unable to locate project $name");
}

sub STgetview
{
    my ($project, $name) = @_;
    
    $name || ($name = STgetname($project));

    my $views = OLEget($project, 'Views');
    foreach my $view (in $views)
    {
        return $view if (STgetname($view) eq $name);
    }

    OLEexit("unable to locate view $name in $project");
}

sub STgetrootfolder
{
    my ($view) = @_;
    return OLEget($view, 'RootFolder');
}

sub STgetsubfolders
{
    my ($folder) = @_;
    return OLEget($folder, 'SubFolders');
}

sub STgetfilelist
{
    my ($folder) = @_;
    return OLEcall($folder, 'enumerateItems', 'File');
}

sub STgetfiletype
{
    my ($file) = @_;
    OLEget($file, 'Binary', 1) && return "Binary";
    return "Text";
}

sub STgetfilesize
{
    my ($file) = @_;
    return OLEget($file, 'Count');
}

sub STgetfilever
{
    my ($file) = @_;
    return OLEget($file, 'ContentVersion');
}

sub STgetfiledate
{
    my ($file) = @_;
    return OLEget($file, 'ContentModificationTime');
}
sub STgetfilecomment
{
    my ($file) = @_;
    return OLEget($file, 'Description', 1);
}

sub STgetfilepathname
{
    my ($file) = @_;
    return OLEget($file, 'ParentFolderHierarchy') . STgetname($file);
}

sub STgetname
{
    my ($object) = @_;
    return OLEget($object, 'Name');
}

sub STgethistory
{
    my ($object) = @_;
    return OLEget($object, 'History');
}

sub STgetnext
{
    my ($enum) = @_;
    if (OLEcall($enum, 'hasMoreElements'))
    {
        return OLEcall($enum, 'nextElement');
    }
    return 0;
}

sub OLEcall
{
    my ($obj, $meth, @args) = @_;
    my $value = $obj->Invoke($meth, @args);
    defined($value) || OLEexit("Unable to call $meth", $obj);
    return $value;
}

sub OLEget
{
    my ($obj, $prop, $noerr) = @_;
    my $value = $obj->{$prop};
    $noerr || $value || OLEexit("Unable to get $prop", $obj);
    return $value;
}

sub OLEexit
{
    my ($msg, $obj) = @_;
    
    my $OLEerr = Win32::OLE->LastError();
    $stserver && $stserver->disconnect();
    Win32::OLE->Uninitialize();
    
    if ($msg)
    {
        $msg = "stcom: $msg: ";
        $obj && ($msg .= Win32::OLE->QueryObjectType($obj));
        $msg .= "\n  $OLEerr\n";
        convert::log($msg);
        die($msg);
    }
}

1;