#!/usr/bin/perl -w
#=============================================================================
#
#  @(#)Copyright 2006 Etienne URBAH          svnWorkingCopy.pl
#
#  @(#)Prints SubVersion Working Copy Root, any switched or external folder.
#  @(#)Warns for URL having multiple local paths.
#
#  @(#)Works on Windows NT and Unix.
#  @(#)Works only with english, french, german, spanish, italian locale.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.
#
#  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 svnWorkingCopy ;

use strict ;

#-----------------------------------------------------------------------------
#  Global Constants
#-----------------------------------------------------------------------------
our $pathMsg = 'Path|Chemin|Pfad|Ruta|Percorso' ;
our $urlMsg  = 'URL' ;

our $b_Windows = defined($ENV{'OS'}) && ( $ENV{'OS'} eq 'Windows_NT' ) ;

our $sep = ( $b_Windows ? '\\' : '/'   ) ;     # Folder separator
our $Q   = ( $b_Windows ? '"'  : "'"   ) ;     # Quoting character
our $pwd = ( $b_Windows ? 'cd' : 'pwd' ) ;     # Command to get current folder

#-----------------------------------------------------------------------------
#  Global variables
#-----------------------------------------------------------------------------
our $b_bare  = 0 ;                       # True if option '-bare'
our $b_debug = 0 ;                       # True if option '-debug'

our $rootUrl ;                           # URL of the Working Copy root folder
our %urlPaths ;                          # Key=URL,  value=Array of paths
our %pathUrls ;                          # Key=path, value=URL


#=============================================================================
#
#  Subroutine  getSvnInfo ($message, $rootPath, @parameters) returns nothing
#
#  This subroutine issues a 'svn info' command and parses the output :
#  - When the path is '.', it prints the SubVersion Working Copy Root.
#  - It prints switched and external folders with their URL.
#  - It stores in %urlPaths the list of folders for each URL.
#
#  This subroutine reads and writes into following global variables :
#  $rootUrl, %urlPaths, %pathUrls
#
#=============================================================================
sub getSvnInfo
{
  my ($message,                   # 'switched' or 'external folder'
      $rootPath,                  # Working Copy root folder
      @parameters)                # Parameters to the 'svn info' command
    = @_ ;
  
  my $path ;                      # Current path
  my $url ;                       # URL of the current path
  my $urlEnd ;                    # End of the current URL (after $rootUrl)
  my $pathBegin ;                 # Path begin matched with previous path 
  my $pathEnd ;                   # End of the current path (after $pathBegin)

  my $command = 'svn info '.$Q.join($Q.' '.$Q, @parameters).$Q ;
  if  ( $b_debug )
      { print "\nCommand=", $command, "\n" }

  open(SVN, $command.'|')  or  die $command, ' :  ', $!, "\n" ;
  while  ( <SVN> )
  {
    if     ( m#^($pathMsg)\s*:\s+(.*)# )
           {
             $path =  $2 ;
             $path =~ y#\\#/# ;
           }
    
    elsif  ( m#^($urlMsg)\s*:\s+(.*)# )
           {
             $url    =  $2 ;
             if  ( $path eq '.' )
                 {
                   $rootUrl = $url ;
                   print "\nSubVersion Working Copy Root:    URL='", $rootUrl,
                         "'\nPath'=", $rootPath, "'\n" ;
                 }
             push(@{$urlPaths{$url}}, $path) ;
             $urlEnd =  $url ;
             $urlEnd =~ s#^$rootUrl/## ;
             if  ( $b_debug )
                 { print "path='", $path, "'   urlEnd='", $urlEnd, "'\n" }
             
             if  ( ($path ne '.') and ($urlEnd ne $path) )
                 {
                   #----------------------------------------------------------
                   #  When a path follows its parent folder, ignore the path
                   #----------------------------------------------------------
                   undef $pathEnd ;
                   foreach  my $path1  ( keys %pathUrls )
                   {
                     if  ( $path =~ m#$path1(.*)# )
                         {
                           $pathBegin = $path1 ;
                           $pathEnd   = $1 ;
                           if  ( $b_debug )
                               { print "pathBegin='", $pathBegin,
                                       "'   pathEnd='", $pathEnd, "'\n" }
                           last ;
                         }
                   }
                   if  ( not ( defined($pathEnd) and
                               ($url =~ m#$pathUrls{$pathBegin}(.*)#) and
                               ($1 eq $pathEnd) ) )
                       {
                         $pathUrls{$path} = $url ;
                         print "\nPath '", $path, "' ", $message, " to '",
                               $url, "'\n" ;
                       }
                 }
           }
  }
  close(SVN) ;
}


#=============================================================================
#
#  Main program
#
#=============================================================================
my $svnWorkingCopyMarker = $sep.'.svn' ;             # SVN working copy marker

#-----------------------------------------------------------------------------
#  Process '-bare' and '-debug' options
#-----------------------------------------------------------------------------
foreach  ( @ARGV )
{
  $_ = lc($_) ;
  if     ( ($_ eq '-b') or ($_ eq '-bare') )
         { $b_bare = 1 }
  elsif  ( ($_ eq '-d') or ($_ eq '-debug') )
         { $b_debug = 1 }
}

#-----------------------------------------------------------------------------
#  Go to the SubVersion Working Copy Root
#-----------------------------------------------------------------------------
if  ( not -d '.svn' )
    { die "You are NOT inside a SubVersion Working Copy\n" }

my $rootPath ;                                      # Working Copy root folder

while  ( 1 )
{
  $rootPath = `$pwd` ;
  if  ( (length($rootPath) <= 4) or ( not -d '..'.$svnWorkingCopyMarker) )
      { last }
  chdir '..' ;
}
chomp $rootPath ;

#-----------------------------------------------------------------------------
#  Search for items not under version control and external folders.
#  When option '-bare', only print switched and external folders
#-----------------------------------------------------------------------------
my $firstChar ;                     # First character of 'svn status' output
my @itemsNotUnderVersionControl ;   # Array of items not under version control
my @externalFolders ;               # Array of external folders

if  ( $b_bare )
    { print "\nSubVersion Working Copy Root:  ", $rootPath, "\n\n" }

open(SVN, 'svn status|')  or  die 'svn status :  ', $!, "\n" ;
while  ( <SVN> )
{
  if  ( (length($_) > 6) )
      {
        $firstChar = substr($_, 0, 1) ;
        if  ( $b_bare and 
              ( ($firstChar eq 'X') or (substr($_, 4, 1) eq 'S') ) )
            { print }
        if     ( $firstChar eq '?' )
               { push(@itemsNotUnderVersionControl, m#^......\s+(.*)#) }
        elsif  ( $firstChar eq 'X' )
               { push(@externalFolders,             m#^......\s+(.*)#) }
      }
}      
close(SVN) ;

if  ( $? )
    { die "'", $rootPath, "' is NOT a SubVersion Working Copy\n" }

if  ( $b_bare )
    { exit }

#-----------------------------------------------------------------------------
#  Print the SubVersion Working Copy Root.
#  Search for switched folders.  Print them with their URL.
#-----------------------------------------------------------------------------
&getSvnInfo('switched', $rootPath, '-R') ;
  
if  ( not defined($rootUrl) )
    { die "'", $rootPath, "' is NOT a SubVersion Working Copy\n" }

#-----------------------------------------------------------------------------
#  Print list of external folders with their URL
#-----------------------------------------------------------------------------
if  ( scalar(@externalFolders) )
    { &getSvnInfo('external folder', $rootPath, @externalFolders) }

#-----------------------------------------------------------------------------
#  Print list of embedded Working Copies with their URL
#-----------------------------------------------------------------------------
my @embeddedWorkingCopies = grep(-d $_.$svnWorkingCopyMarker,
                                 @itemsNotUnderVersionControl) ;
if  ( scalar(@embeddedWorkingCopies) )
    { &getSvnInfo('working copy', $rootPath, @embeddedWorkingCopies) }

#-----------------------------------------------------------------------------
#  Print list of URL having multiple local paths
#-----------------------------------------------------------------------------
my $b_first = 1 ;                     # True if first one
my $b_newUrlWithMultiplePaths ;       # True if URL with multiple paths is new
my %urlsWithMultiplePaths ;           # Key=URL, value=boolean

foreach  my $url  ( sort keys %urlPaths )
{
  if  ( scalar(@{$urlPaths{$url}}) > 1 )
      {
        $b_newUrlWithMultiplePaths = 1 ;
        foreach  my $url1  ( keys %urlsWithMultiplePaths )
        {
          if  ( $url =~ m#^$url1/# )
              {
                $b_newUrlWithMultiplePaths = 0 ;
                last ;
              }
        }
        if  ( $b_newUrlWithMultiplePaths )
            {
              if  ( $b_first )
                  {
                    $b_first = 0 ;
                    print "\n***************  ATTENTION  ***************\n" ;
                  }
              $urlsWithMultiplePaths{$url} = 1 ;
              print "\n'", $url, "' has MULTIPLE local paths :\n" ;
              foreach  ( @{$urlPaths{$url}} )
                       { print '    ', $_, "\n" }
            }
      }
}

__END__
