#!/usr/bin/perl

use strict;
use warnings;

use VCS::Lite::Repository;

my $prompt = 'VCSLite> ';

if (@ARGV) {
	execute_command(join ' ',@ARGV);
	exit(0);
}

$| = 1;

while (1) {
	print $prompt;
	my $cmd = <STDIN>;
	last if !defined($cmd) or $cmd =~ /^quit/;
	execute_command($cmd);
}

sub execute_command {
    local $_ = shift;

    /^prompt (.*)/ && (($prompt = $1), return);

    /^cd (.*)/ && (chdir($1),return);

    /^(add|remove|commit|update)\s+(.*)/ && (VCS_function($1,$2),return);

    /^clone\s+(\S+)\s+(\S+)/ && (VCS_clone($1,$2),return);

    /^ci\s+(.*)/ && (VCS_check_in($1),return);

    /^help/ && (VCS_help(),return);

    /^fetch                   #fetch command
        \s+
        ([^@ \n]+)            #filename => $1
        (?:@@                 #optional @@
        (\w+(?:\.\d+)*))?     #generation specifier => $2
        \s*
        (\>.+)?               #redirect => $3
        /x && (VCS_fetch($1,$2,$3),return);
       
    /^diff                    #diff command
        \s+
        ([^@ \n]+)            #First file => $1
        (?:@@                 #optional @@
        (\w+(?:\.\d+)*))?     #generation specifier => $2
        (?:\s+                #second param is optional
        ([^@ \n]+)?           #Second file => $3
        (?:@@                 #optional @@
        (\w+(?:\.\d+)*))?)?   #generation specifier => $4
        \s*
        (\>.+)?               #redirect => $5
        /x && (VCS_diff($1,$2,$3,$4,$5),return);
        
    system($_);
}

sub VCS_help {
    print <<HELP;
    
VCS::Lite::Repository Version $VCS::Lite::Repository::VERSION

   add element|repository [element|repository...]
   cd repository
   ci name [name...]
   commit name [name...]
   diff file1[\@\@gen1] [file2[\@\@gen2]] [>outfile]
   fetch name\@\@gen [>outfile]
   remove name [name...]
   update name [name...]

   Anything else will be executed as a host operating system command.

HELP
}

sub VCS_function {
    my ($func,$files) = @_;

    my $repos = VCS::Lite::Repository->new('.', verbose => 1);
    my @files = $files =~ /("[^"]+"|\S+)/g;

    for (file_list($files)) {
	$repos->$func($_);
    }
}

sub file_list {
    my $str = shift;

    map {/\*|\?/ ? glob($_) : $_} 
    	$str =~ /("[^"]+"|\S+)/g; 
}

sub VCS_check_in {
    my ($elename) = @_;

    my @expanded = file_list($elename) or return undef;
    print "Enter a description of the change made\n";
    print "Terminate with a dot\n";
    my $remark = '';
    
    while ((my $input = <STDIN>) ne ".\n") {
	$remark .= $input;
    }
    
    for (@expanded) {
	my $ele = (-d $_) ? 
	    VCS::Lite::Repository->new($elename, verbose => 1) :
    	    VCS::Lite::Element->new($elename, verbose => 1);
    				
	$ele->check_in( description => $remark);
    }
}

sub VCS_clone {
    my ($parent,$subsidiary) = @_;

    my $repos = VCS::Lite::Repository->new($parent, verbose => 1);
    $repos->clone($subsidiary);
}

sub VCS_fetch {
    my ($elename,$gen,$outfile) = @_;

    my $ele = VCS::Lite::Element->new($elename);
    my $outf;

    if ($outfile) {
	open $outf,$outfile or warn "Failed to create $outfile, $!";
    } else {
	$outf = \*STDOUT;
    }

    print $outf $ele->fetch( $gen ? (generation => $gen) : undef)->text;
}

sub VCS_diff {
    my ($fil1,$gen1,$fil2,$gen2,$outfile) = @_;

    $fil2 ||= $fil1;
    my (%spc1,%spc2);
    my $ele2 = VCS::Lite::Element->new($fil2);
    $gen2 = $ele2->latest unless defined $gen2;
    my ($ele1);
    if ($fil1 eq $fil2) {
        $gen1 = $ele2->up_generation($gen2) unless defined $gen1;
        print "No prior generation exists\n" unless defined $gen1;
        $ele1 = $ele2;
    }
    else {
        $ele1 = VCS::Lite::Element->new($fil1);
        $gen1 = $ele1->latest unless defined $gen1;
    }
    my $outf;

    my $lit1 = $ele1->fetch( generation => $gen1);
    my $lit2 = $ele2->fetch( generation => $gen2);
    my $delt = $lit1->delta($lit2) or return;

    if ($outfile) {
	open $outf,$outfile or warn "Failed to create $outfile, $!";
    } else {
	$outf = \*STDOUT;
    }

    print $outf $delt->udiff;
}
    
    
=head1 NAME

VCShell  - a command line interface for L<VCS::Lite::Repository>

=head1 SYNOPSIS

   B<add> element|repository [element|repository...]
   B<remove> name [name...]
   B<ci> name [name...]
   B<commit> name [name...]
   B<update> name [name...]
   B<cd> repository
   B<fetch> name@@gen [>outfile]
   B<diff> file1[@@gen1] [file2[@@gen2]] [>outfile]

=head1 DESCRIPTION

VCShell provides a command line interface to the VCS Lite Repository. This
aims to be usable by non-Perl programmers, as it provides a wrapper to the
functionality in the module.

=head1 COMMANDS

=head2 add

The C<add> command adds something to a repository: an element or a repository.
If the parameter given is a directory, it makes it a repository, otherwise
an element. An empty file is created for the element if none exists.

=head2 remove

Remove breaks the association between a repository and something it contains.
It does not delete any files.

=head2 ci

This command is used to B<check in> changes to one or more elements and 
repositories. Each repository checked in is also recursively checked in.

=head2 clone

This makes a B<clone> of one repository into another, and recursively for
everything in it. The new repository contains a B<parent> link which points
at the original.

=head2 commit

If the repository is a clone of a parent repository, this propagates any 
changes to the parent. Note, a check in (B<ci>) is needed on the parent,
for this change to be applied.

=head2 update

This command is used to apply any changes that have happened to the parent.
Three way merging occurs for any change that has happened in the mean time.

=head2 diff

This command outputs a udiff listing for two generations of an element, or
for two different elements. The default generation used is the latest, and the
default generation for the "from" file is the predecessor to the "to" 
generation if comparing the same element.

The output is in diff -u format.

=head1 COPYRIGHT

Copyright (C) 2003-2004 Ivor Williams (IVORW (at) CPAN {dot} org)
All rights reserved.

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

