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