The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# $Revision: 709 $$Date: 2005-05-03 17:32:07 -0400 (Tue, 03 May 2005) $$Author: wsnyder $
# Author: Wilson Snyder <wsnyder@wsnyder.org>
######################################################################
#
# Copyright 2002-2005 by Wilson Snyder.  This program is free software;
# you can redistribute it and/or modify it under the terms of either the GNU
# General Public License or the Perl Artistic License.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
######################################################################

package P4::C4::Client;
require 5.006_001;

use strict;
use Carp;

use P4::Getopt;
use P4::C4::Cache;
use P4::C4::Info;

######################################################################
#### Configuration Section

our $VERSION = '2.041';

#######################################################################
#######################################################################
#######################################################################
# Client Interface

package P4::C4::Client::CreateUI;
use P4::C4::UI;
use strict;
our @ISA = qw( P4::C4::UI );

sub Edit {
    my $self = shift;
    my $filename = shift;
    print __FUNCTION__.": $filename\n" if $P4::C4::Debug;

    # Replace the appropriate fields in the template
    # Read it
    my $ifh = IO::File->new($filename) or die "%Error: $! $filename,";
    my $wholefile = join('',$ifh->getlines);
    $ifh->close();

    # Edits
    my $out = "";
    my $des;
    foreach my $line (split /\n/, $wholefile) {
	$line =~ s/\b(Host:\t)\S+/$1/mg;
	$line =~ s/\bnoallwrite\b/allwrite/mg if $self->{c4} || $self->{allwrite};
	$line =~ s/\bnoclobber\b/clobber/mg if $self->{c4} || $self->{clobber};
	$line =~ s/\bnormdir\b/rmdir/mg if $self->{rmdir};
	if ($line =~ /^Description:/) {
	    $des=1;
	}
	elsif ($des && $line =~ /^[a-z\#]/i) {
	    $des=0;
	    $out .= "\tManaged by c4.\n\n" if $self->{c4};
	}
	$out .= "$line\n";
    }

    # Write it back
    my $fh = IO::File->new($filename,"w") or die "%Error: $! $filename,";
    print $fh $out;
    $fh->close();

    # Now let the user do their thing.
    P4::UI->Edit($filename);
}

#######################################################################
# Client Interface

package P4::C4::Client::DeleteUI;
use P4::C4::UI;
use strict;
our @ISA = qw( P4::C4::UI );

sub Edit {
    my $self = shift;
    my $filename = shift;
    print __FUNCTION__.": $filename\n" if $P4::C4::Debug;

    # Read it
    my $ifh = IO::File->new($filename) or die "%Error: $! $filename,";
    my $wholefile = join('',$ifh->getlines);
    $ifh->close();

    # Edits
    my $out = "";
    my $view;
    foreach my $line (split /\n/, $wholefile) {
	if ($line =~ /^View:/) {
	    $view=1;
	} elsif ($line =~ /^[a-z\#]/i) {
	    $view=0;
	} elsif ($view) {
	    next;
	}
	$out .= "$line\n";
    }

    # Write it back
    my $fh = IO::File->new($filename,"w") or die "%Error: $! $filename,";
    print $fh $out;
    $fh->close();
}

#######################################################################
#######################################################################
#######################################################################
# Client View Interface

package P4::C4::Client::ViewUI;
use P4::C4::UI;
use strict;
our @ISA = qw( P4::C4::UI );

sub OutputInfo {
    my $self = shift;
    my $level = shift;
    my $data = shift;

    if ($level==0) {
	my $inview;
	print __PACKAGE__.": $level: $data\n" if $P4::C4::Debug;
	foreach my $line (split /\n/, $data) {
	    if ($line =~ /^View:/) {
		$inview = 1;
	    } elsif ($inview && $line =~ /^\s+(\S+)\s+(\S+)/) {
		push @{$self->{view}}, [$1, $2];
	    } elsif ($line =~ /Managed by c4/) {
		$self->{c4_managed} = 1;
	    } else {
		$inview = 0;
	    }
	}
    } else {
	die "$0: %Error: Bad p4 response: $data\n";
    }
}

#######################################################################
#######################################################################
#######################################################################
# OVERRIDE METHODS

package P4::C4;
use File::Path;
use File::Spec::Functions;
use Cwd;

sub createClient {
    my $self = shift;
    my @args = @_;  # allwrite, clobber, rmdir, c4
    # Create the client
    print "createClient ",join(' ',@args),"\n" if $P4::C4::Debug;

    (! -r ".p4config") or die "%Error: Client already exists (.p4config file exists)\n";

    # Set client name
    my %opts = P4::Getopt->hashCmd('client-create', @args);
    #use Data::Dumper; print Dumper(\%opts) if $P4::C4::Debug;
    (!$opts{unknown}) or die "%Error: Unknown create-client switch\n";
    $opts{client}[0] or die "%Error: New client name not specified\n";
    $self->SetClient($opts{client}[0]) if $opts{client}[0];

    # Call perforce to make the client
    my @p4args = @args;
    @p4args = P4::Getopt->stripOneArg('-c4',@p4args);
    @p4args = P4::Getopt->stripOneArg('-rmdir',@p4args);

    my $ui = new P4::C4::Client::CreateUI ('c4' => $opts{-c4},
					   'rmdir' => $opts{-rmdir},);
    $self->Run($ui,'client',@p4args);

    # Check the user didn't modify the description
    if ($opts{-c4} && !$self->clientC4Managed) {
	warn "%Error: The Description: ... 'Managed by c4.' shouldn't be deleted\n"
	    ."        Please use 'c4 client' and add it back.\n";
    }

    # Write .p4config file
    my $cfgfilename = $ENV{P4CONFIG} or die "%Error: P4CONFIG not in enviornment,";
    my $fh = IO::File->new($cfgfilename,"w",0777) or die "%Error: $! %cfgfilename,";
    chmod 0777, $cfgfilename;
    printf $fh "P4CLIENT=".$self->GetClient()."\n";
    my $user = ($ENV{P4USER}||$ENV{USER});
    printf $fh "P4USER=$user\n" if $user;
    printf $fh "#C4\n";	   # Magic sequence so know under our control
    $fh->close();

    unlink('.c4cache');
    $self->rmCache();

    return 1;
}

#######################################################################

sub clientDelete {
    my $self = shift;
    my @args = @_;

    print "clientDelete ",join(' ',@args),"\n" if $P4::C4::Debug;

    # Set client name
    my %opts = P4::Getopt->hashCmd('client-delete', @args);
    (!$opts{unknown}) or die "%Error: Unknown create-delete switch\n";
    $opts{client}[0] or die "%Error: Deletion client name not specified\n";
    $self->SetClient($opts{client}[0]) if $opts{client}[0];

    # Check if it exists
    my $root = $self->clientRoot;
    defined $root or die "%Error: Client '$opts{client}[0]' doesn\'t exist.\n";
    print "Root $root\n" if $P4::C4::Debug;
    my $madedir;
    if (-r $root) {
	print "Deleting client $opts{client}[0] and client directory $root...\n";
    } else {
	print "Deleting client $opts{client}[0] and empty client directory $root...\n";
	$madedir = 1;
	mkpath $root;
	(-r $root) or die "%Error: Can't create directory: $root\n";
    }

    # Chdir
    my $orig_pwd = getcwd();
    chdir($root);
    $self->SetCwd($root);

    my $ui = new P4::C4::UI(c4self=>$self, noneOpenOk=>1);

    # Revert any open files
    $self->Run($ui,'revert','...');

    {   # Edit the view to remove old areas
	my $eui = new P4::C4::Client::DeleteUI(c4self=>$self);
	$self->Run($eui,'client');
    }

    # Sync to remove the old view files
    $self->Run($ui,'sync','-f');

    {   # Call perforce to delete the client
	my @delargs = ();  
	push @delargs, '-f' if $opts{-f};
	$self->Run($ui,'client','-d', @delargs, $opts{client}[0]);
    }

    # Delete created files
    unlink(catfile($root,".c4cache"));
    unlink(catfile($root,".p4config"));
    rmdir $root if $madedir;

    chdir $orig_pwd;
    $self->SetCwd($orig_pwd);

    return 1;
}

######################################################################

sub clientDetails {
    my $self = shift;
    my @args = @_;
    # Return view fields from current client

    $self->{view} = [];

    my $ui = new P4::C4::Client::ViewUI (c4self=>$self);
    $self->Run($ui,'client','-o');

    return ($ui);
}

sub clientView {
    my $self = shift;
    my $ui = $self->clientDetails(@_);
    return (@{$ui->{view}});
}

sub clientC4Managed {
    my $self = shift;
    if (!defined $self->{c4_managed}) {
	if (-e $self->cacheFilename) {
	    $self->{c4_managed} = 1;
	} else {
	    my $ui = $self->clientDetails(@_);
	    $self->{c4_managed} = $ui->{c4_managed} ? 1:0;
	}
    }
    return $self->{c4_managed}; 
}

######################################################################
### Package return
1;
__END__

=pod

=head1 NAME

P4::C4::Client - Client utilities

=head1 SYNOPSIS

  use P4::C4::Client;

  my $p4 = new P4::Client;
  $p4->createClient( \@args );
  ...

=head1 DESCRIPTION

This module provides utilities to operate on Perforce clients.

=head1 METHODS

=over 4

=item $self->createClient ( args )

Create the client in a way supported by c4.  With the '-c4' parameter, set
clobber, allwrite.  With '-rmdir', set rmdir.  You'll probably also want
the -t template argument.

=item $self->clientView ( args )

Return an array with the view of the current client.

=back

=head1 DISTRIBUTION

The latest version is available from CPAN and from L<http://www.veripool.com/>.

Copyright 2002-2005 by Wilson Snyder.  This package is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License or the Perl Artistic License.

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

L<P4::Client>, L<P4::C4>, 

=cut