13
« on: October 05, 2007, 10:56:43 am »
#!/cygwin/bin/perl -W
####################################################
# updateDBModel.pl
# Update the Oracle model from subversion repository
# this can runs as a cgi-script....
# important is to check the permissions for the
# executing user on the DCOM object EA
# Created on: 06-Jul-2007 13:28:22
# Original author: Dr. UV Wildner
####################################################
#
# set autoflush and provide an html header....
$|=1;
print "Content-type: multipart/x-mixed-replace;boundary=BOUNDARY\n\n--BOUNDARY\n";
use strict;
use Win32::OLE;
# connection string for the DB model
my $model = "ShareTV --- DBType=3;Connect=Provider=OraOLEDB.Oracle.1;Password=xxx;Persist Security Info=True;User ID=xxx;Data Source=XXXX";
#my $model = "C:/YourModel.eap"; # modify as needed
my $WorkingCopy="C:/YourWorkingCopy";
my $debug=1;
my $verbose=0;
my %PKGSTATES;
#
#########################################################################################
# functions
#########################################################################################
sub printPkgStates
{
my ($hashref) = @_;
my $key;
foreach $key (keys %$hashref)
{
print "$key $$hashref{$key}\n";
}
}
#########################################################################################
sub getEnumCheckOutStatus
{
my ($package) = @_;
my $i = $package->VersionControlGetStatus();
return "csUncontrolled " if ($i == 0);
return "csCheckedIn " if ($i == 1);
return "csCheckedOutToThisUser " if ($i == 2);
return "csReadOnlyVersion " if ($i == 3);
return "csCheckedOutToAnotherUser " if ($i == 4);
return "csOfflineCheckedOutToThisUser " if ($i == 5);
return "csOfflineNotCheckedOutToThisUser" if ($i ==6);
return "csDeleted " if ($i ==7);
return "csUnknown ";
}
#########################################################################################
# recursive Package traverse using high order functions
sub dumpPackages
{
my ($pkgCollection,$funcref,@rest) = @_;
for (my $j=0;$j < $pkgCollection->Count;$j++)
{
my $package = $pkgCollection->GetAt($j);
if ($funcref)
{
&$funcref($package,@rest);
}
# recurse children
&dumpPackages($package->Packages,$funcref, @rest);
}
}
#########################################################
# 2 functions to be passed into recursion #
#########################################################
my $collectNames = #
sub { #
my ($package) = @_; #
if ($package->isVersionControlled) #
{ #
my $pkgstate = getEnumCheckOutStatus($package); #
$PKGSTATES{$pkgstate}++; # count states #
print "Package => ", $package->Name," $pkgstate\n";
} #
}; #
#########################################################
my $checkout = #
sub { #
my ($package,$projectInterface) = @_; #
if ($package->isVersionControlled) #
{ #
my $guid = $package->PackageGUID; #
my $pkgstate = getEnumCheckOutStatus($package); #
$PKGSTATES{$pkgstate}++; # count states #
print "\nContent-type: text/plain\n\n"; #
print "Package => ",$package->Name," $pkgstate\n";#
print "--BOUNDARY\n"; #
$projectInterface->LoadControlledPackage($guid); #
} #
}; #
#########################################################
sub OleQuit {
my ($ea) = @_;
$ea->Exit();
}
#########################################################
# update working copy from subversion
print "\nContent-type: text/plain\n\n";
die "model file $model not found\n" unless (-f $model || $model =~ /DBType/);
chdir $WorkingCopy;
my $svnCMD = "svn update --username XXX --password YYYY 2>&1 > .svnUpdate.log";
system ($svnCMD) == 0
or die "system [$svnCMD] failed: $?";
print "svn in $WorkingCopy updated\n" if $debug;
print "--BOUNDARY\n";
#########################################################
# Open the model file
print "\nContent-type: text/plain\n\n";
# this is where the access permission have to be right for the perl script!!! (if run as a batch or as a CGI)
my $repository = Win32::OLE->new('EA.Repository', \&OleQuit) or die "oops cannot access Repository interface\n--BOUNDARY--\n";
$repository->EnableCache;
my $result = $repository->OpenFile($model);
print "file opened\n" if $result;
die $repository->GetLastError ()."\n--BOUNDARY--\n" unless $result;
my $allModels = $repository->Models();
die "no models found in $model\n--BOUNDARY--\n" unless ($allModels);
# get the XML/Report interface
my $projectInterface = $repository->GetProjectInterface();
print "found " , $allModels->Count, " models in file\n";
print "--BOUNDARY\n";
for (my $i=0;$i < $allModels->Count;$i++)
{
my $model = $allModels->GetAt($i);
print "\nContent-type: text/plain\n\n";
print "model ==> ", $model->Name, "\n";
print "--BOUNDARY\n";
&dumpPackages($model->Packages,$checkout,$projectInterface);
}
print "\nContent-type: text/plain\n\n";
&printPkgStates(\%PKGSTATES);
print "--BOUNDARY--\n";
Show Posts
