1#!/usr/bin/perl -w 2# BEGIN BPS TAGGED BLOCK {{{ 3# COPYRIGHT: 4# 5# This software is Copyright (c) 2003-2008 Best Practical Solutions, LLC 6# <clkao@bestpractical.com> 7# 8# (Except where explicitly superseded by other copyright notices) 9# 10# 11# LICENSE: 12# 13# 14# This program is free software; you can redistribute it and/or 15# modify it under the terms of either: 16# 17# a) Version 2 of the GNU General Public License. You should have 18# received a copy of the GNU General Public License along with this 19# program. If not, write to the Free Software Foundation, Inc., 51 20# Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit 21# their web page on the internet at 22# http://www.gnu.org/copyleft/gpl.html. 23# 24# b) Version 1 of Perl's "Artistic License". You should have received 25# a copy of the Artistic License with this package, in the file 26# named "ARTISTIC". The license is also available at 27# http://opensource.org/licenses/artistic-license.php. 28# 29# This work is distributed in the hope that it will be useful, but 30# WITHOUT ANY WARRANTY; without even the implied warranty of 31# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 32# General Public License for more details. 33# 34# CONTRIBUTION SUBMISSION POLICY: 35# 36# (The following paragraph is not intended to limit the rights granted 37# to you to modify and distribute this software under the terms of the 38# GNU General Public License and is only of importance to you if you 39# choose to contribute your changes and enhancements to the community 40# by submitting them to Best Practical Solutions, LLC.) 41# 42# By intentionally submitting any modifications, corrections or 43# derivatives to this work, or any other work intended for use with SVK, 44# to Best Practical Solutions, LLC, you confirm that you are the 45# copyright holder for those contributions and you grant Best Practical 46# Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free, 47# perpetual, license to use, copy, create derivative works based on 48# those contributions, and sublicense and distribute those contributions 49# and any derivatives thereof. 50# 51# END BPS TAGGED BLOCK }}} 52use strict; 53 54BEGIN { 55 eval { 56 my $x = ''; 57 my $y = \$x; 58 require Scalar::Util; Scalar::Util::weaken($y); 59 }; 60 if ($@) { 61 CORE::die <<"EOF"; 62 63SVK requires the Scalar::Util module be built with support for the 'weaken' 64function. 65 66It is sometimes the case that operating system upgrades will replace 67a working Scalar::Util with a non-working one. If your system was working 68correctly up until now, this is likely the cause of the problem. 69 70Please reinstall Scalar::Util, being careful to let it build with your C 71compiler. Usually this is as simple as running the following command as 72root: 73 74 perl -MCPAN -e'install Scalar::Util' 75 76EOF 77 } 78} 79 80use SVK; 81our $VERSION = $SVK::VERSION; 82use SVK::I18N; 83use Getopt::Long qw(:config no_ignore_case bundling); 84use autouse 'SVK::Util' => qw(get_anchor catfile catdir find_dotsvk); 85use Class::Autouse qw(SVK::Command SVK::XD); 86 87=head1 NAME 88 89svk - A Distributed Version Control System 90 91=head1 SYNOPSIS 92 93B<svk> I<command> S<[I<options>]> [I<args>] 94 95=head1 DESCRIPTION 96 97B<SVK> is a decentralized version control system written in Perl. 98It uses the Subversion filesystem but provides additional features: 99 100=over 4 101 102=item * Offline operations like C<checkin>, C<log>, C<merge>. 103 104=item * Distributed branches. 105 106=item * Lightweight checkout copy management (no F<.svn> directories). 107 108=item * Advanced merge algorithms, like I<star-merge> and I<cherry picking>. 109 110=back 111 112For more information about the SVK project, visit L<http://svk.bestpractical.com/>. 113 114Run C<svk help> to access the built-in tool documentation. 115 116By default svk stores its state in the F<.svk> directory in your home 117directory. You can change this default by setting the SVKROOT environment 118variable to your preferred svk depot path. 119 120=cut 121 122my $cmd = shift; 123 124if (!$cmd or $cmd =~ /^-{0,2}[Hh](?:elp)?$/) { 125 SVK::Command->invoke (undef, 'help', undef, @ARGV); 126 exit 0; 127} 128 129{ 130 my $show_version; 131 local *ARGV = [$cmd || '']; 132 GetOptions ('v|version' => \$show_version) or exit; 133 134 if ($show_version || ($cmd && $cmd eq 'version')) { 135 print loc("This is svk, version %1 (using Subversion bindings %2)\n", 136 $VERSION, $SVN::Core::VERSION); 137 exit 0; 138 } 139} 140 141$ENV{HOME} ||= ( 142 $ENV{HOMEDRIVE} ? catdir(@ENV{qw( HOMEDRIVE HOMEPATH )}) : '' 143) || (getpwuid($<))[7]; 144$ENV{USER} ||= ( 145 (defined &Win32::LoginName) ? Win32::LoginName() : '' 146) || $ENV{USERNAME} || (getpwuid($<))[0]; 147 148my $svkpath = find_dotsvk || $ENV{SVKROOT} || catfile($ENV{HOME}, ".svk"); 149my $floating = undef; 150if (-e catfile($svkpath, 'floating')) { 151 require Path::Class; 152 $floating = Path::Class::Dir->new( $svkpath )->parent(); 153} 154my $ret; 155{ 156 my $xd = SVK::XD->new ( giantlock => catfile($svkpath, 'lock'), 157 statefile => catfile($svkpath, 'config'), 158 svkpath => $svkpath, 159 floating => $floating, 160 ); 161 $xd->load(); 162 $SIG{INT} = sub { 163 die loc("Interrupted.\n"); 164 }; 165 166 $ret = SVK::Command->invoke ($xd, $cmd, undef, @ARGV); 167 $xd->store (); 168} 169 1701; 171 172exit (defined $ret ? $ret : 1); 173 174require PerlIO; 175require PerlIO::via; 176require PerlIO::scalar; 177require Encode::TW; 178 179=head1 AUTHORS 180 181Chia-liang Kao E<lt>clkao@clkao.orgE<gt> 182 183=head1 COPYRIGHT 184 185Copyright 2003-2005 by Chia-liang Kao E<lt>clkao@clkao.orgE<gt>. 186 187This program is free software; you can redistribute it and/or modify it 188under the same terms as Perl itself. 189 190See L<http://www.perl.com/perl/misc/Artistic.html> 191 192=cut 193