Fw: [p4perl] sync problems

Fri Mar 11 03:31:37 PST 2005

As requested, more detail on the script:

package PerforceClient;

use strict;
use lib qw(autobuild autobuild/makedist/bt/perl5libs);

use Net::Domain;
use Platform;
use P4;
use Status;
use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT @EXPORT_OK );

@ISA = qw( P4 );

sub new 
{
  my $self = shift;

  unless ( ref $self) 
  {
    #
    # must have root as an argument
    my $objref = new P4;
    bless $objref, $self;
    $objref->ParseForms();
    $objref->Init() or die("Failed to connect to Perforce");
    $objref->{ _error } = "";
    $objref->{ _depot } = "//depot";
    $objref->{ _hostname} =  Net::Domain::hostname;
    $objref->{ _Root } = "";
    $objref->setPerforceWorkingSpace();
    $objref->setDefaultRoot();
    $objref->setRootToDefault();
    return $objref;
  }
}

#
# in perforce, the branch is just another directory name
# date: YYYY/MM/dd
sub fetchFile
{
  my $self = shift;
  my (%params) = @_;
  my $name = $params{name};
  # YYYY/mm/dd
  my $date = $params{date};
  # hh:mm:ss
  my $time = $params{time};
  my $file = $params{file};
  my $dest = $params{dest}; 
  #
  #
  print "dest: $dest\n";
  #
  # make sure destination and name exists
  if (!-d $dest)
  {
    print "dest $dest does not exist\n";
    return -1;
  }
  $self->setRoot( $dest ) if ($dest);
  # synchronise cache
  if ($date) 
  {

    $self->Sync("-f",$self->{_depot}."/".$name."/".$file."@".$date);
  }
  elsif ( $time ) 
  {
    if (!$date) 
    {
      # iso format date
      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
localtime();
      $date=$year."/".$mon."/".$mday;
    }
    my $datetime = $date.":".$time;
    $self->Sync("-f",$self->{_depot}."/".$name."/".$file."@".$datetime);
  }
  else 
  {
    my $url = $self->{_depot}."/".$name."/".$file."#head";
    print "file to sync: ".$url."\n";
    my $val = $self->Run("Sync","-f", "$url"); 
    print "return value $!\n";
  }
}

sub setPerforceWorkingSpace
{
  my $self = shift;
  print "hostname: ".$self->{_hostname}."\n"; 
  $self->{_PerforceWorkingSpace} = $self->FetchClient( 
$self->{_hostname});
}
sub getPerforceClientRoot
{
  my $self = shift;
  print "getPerforceClientRoot\n";
  print "workingspace: ".$self->{_PerforceWorkingSpace}->{Root} ."\n";
  return $self->{_PerforceWorkingSpace}->{Root};
}
sub setPerforceClientRoot
{
  my $self = shift;
  print "setPerforceClientRoot\n";
  print "hostname ". $self->{_hostname}."\n";
  my $ws = $self->{_PerforceWorkingSpace};

  #
  # currently, we only change root
  if ($self->{_Root} ne $self->{_DefaultRoot}) 
  {
    print "changing root from ".$self->{_DefaultRoot}." to 
".$self->{_Root}."\n";
    $ws->{Root} = $self->{_Root};
    $self->SaveClient( $ws ); 
  }
  else 
  {
    print "no change of root\n";
  }
}

sub getDefaultRoot
{
  my $self = shift;
  return $self->{_DefaultRoot};
}
sub setDefaultRoot
{
  my $self = shift;
  print "setDefaultRoot\n";
  $self->{_DefaultRoot} = $self->getPerforceClientRoot();
}

sub getRoot
{
  my $self = shift;
  return $self->{_Root};
}
sub setRoot
{
  my $self = shift;
  my $root = shift;
  print "setRoot $root\n";
  $self->{_Root} = $root;
  $self->setPerforceClientRoot();
}
sub setRootToDefault
{
  my $self = shift;
  print "setRootToDefault\n";
  $self->{_Root} = $self->{_DefaultRoot};
}

sub DESTROY
{
  my $self = shift;
  print "destroy\n";
  #
  # reset the working space of the client to the default
  $self->setRoot( $self->{_DefaultRoot} );
}
1;

Tests follow:

#
# $HopeName$
# $Id$
#
package Tests::PerforceClientTests;

use strict;
use lib qw(autobuild autobuild/makedist/bt/perl5libs);
use Cwd;

use PerforceClient;

use FileHandle;
use File::Path;

use Fileutil;

use base qw(Test::Class);
use Test::More;

sub  make_perforce_client : Test(setup)
{
  print "setup\n";
  print "setting perforce_client\n";
  shift->{perforce_client} = PerforceClient->new;
};
sub make_temporary_root : Test(setup)
{
  # new temporary root
  print "setting temporary_root\n";
  my @curdir = File::Spec->splitdir(cwd);
  my $tmp = File::Spec->catdir(@curdir,'autobuild','tests','tmp');
  shift->{tmp} = $tmp;
  #
  # create directory
  mkpath( $tmp );
};
sub remove_temporary_root : Test(teardown)
{
  my $self = shift;
  my $tmpdir = $self->{tmp};
  my $pc = $self->{perforce_client};
  $pc->DESTROY();
  print "remove_temporary_root\n";
#  Fileutil::Erase('--force' => 1, '--ignore-missing' => 1, 'name' => 
$tmpdir, '--verbose' => 1);
};

sub test_getDefaultRoot : Test
{
  my $self = shift;
  my $pc = $self->{perforce_client};
  my $tmpdir = $self->{tmp};
  print "test_getDefaultRoot\n";

  my $dr = $pc->getDefaultRoot();

  print "default root: ".$dr."\n";
  ok($pc->getDefaultRoot(), $pc->getRoot());

};

sub test_setDefaultRoot : Test
{
  my $self = shift;
  my $pc = $self->{perforce_client};
  print "test_setDefaultRoot\n";

  my $dr = $pc->getDefaultRoot();

  $pc->setRoot("c:\\hqbin\\perforce_root_2");
  my $nr = $pc->getPerforceClientRoot();
  ok($nr, $pc->getRoot());

};

sub test_fetchFileWithNewRoot : Test
{
  my $self = shift;
  my $pc = $self->{perforce_client};
  my $tmp = $self->{tmp};

$pc->fetchFile(name=>"swig_tests/simple_build",file=>"product.xml",dest=>$tmp);
  my $testfile = 
File::Spec->catfile($tmp,'swig_tests','simple_build','product.xml');

  if (-e $testfile ) 
  {
    pass("file ".$testfile."has been retreived");
  }
  else 
  {
    fail("file ".$testfile." has not been found");
  }
};
1;
#
# $Log$
#
----- Forwarded by Roger Day/Harlequin on 11/03/2005 11:27 -----

"Roger Day" <roger.day at globalgraphics.com>
Sent by: p4perl-bounces at perforce.com
10/03/2005 17:13

        To:     p4perl at perforce.com
        cc: 
        Subject:        [p4perl] sync problems

I've reset the client root and tried this command:

my $val = $self->Run("Sync","-f", "$url");

where $url eq //depot/swig_tests/simple_build/product.xml#head

but nothing happens. I've upped the debug (using p4 -s P4DEBUG="server=1")
and all I get this:

Perforce server warning:
2005/03/10 17:04:49 pid 2468 rday at mauberley 127.0.0.1 'user-client -o
mauberley'
Perforce server warning:
2005/03/10 17:04:50 pid 2468 rday at mauberley 127.0.0.1 'user-client
-i'
Perforce server warning:
2005/03/10 17:04:51 pid 2240 rday at mauberley 127.0.0.1 'user-client -o
mauberley'
Perforce server warning:
2005/03/10 17:04:52 pid 1880 rday at mauberley 127.0.0.1 'user-client -o
mauberley'

which doesn't look meaningful to me. Are there any other tricks to try and
get the server to cough up more data? Why doesn't $! yield an error 
message
of some kind?

Roger.

_______________________________________________
p4perl mailing list
p4perl at perforce.com
http://maillist.perforce.com/mailman/listinfo/p4perl
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://p4tress.perforce.com/pipermail/p4perl/attachments/20050311/923e5fff/attachment-0001.html