CGI::Ex::Recipes::Install

    if ( $dest =~ /$src/ ) {
        print
            "Destination path: '$dest'$/ can not be under$/"
            . "source path: '$src'$/... exiting.$/";
        exit;
    }

package CGI::Ex::Recipes::Install;
use utf8;
use warnings;
use strict;
use Carp qw(croak);
use Data::Dumper;
use CGI();
use File::Find;
use File::Copy;
use File::Path;
use Cwd qw(realpath);
use File::Spec::Functions qw(rel2abs);
use IO::File;
use Config;
our $VERSION = '0.2';
our ($src,$dest);

#starts the install procedure
sub new {
    my $class = shift || croak "Usage: ".__PACKAGE__."->new";
    my $self  = ref($_[0]) ? shift() : (@_ % 2) ? {} : {@_};
    bless $self, $class;
    $self->_init;
    return $self;
}

#???
sub _init {
    my $self = shift;
    $self->{q} = CGI->new();
    if(!$self->{q}->param()){croak "Usage: ".usage()}
    #1. Guess the mode - offline is default
    
    #2. Collect info about the environment and exit gracefully if 
    #permissions or anything needed is missing
    return $self;
}

#install the application
sub run {
    my $self = shift;
    
    $self->{q}->print( Dumper( \%{$self->{q}->Vars()} ) );
    $self->install;
}

sub install {
        my $self = shift;
    #Yeah, there is File::Copy::Recursive but I needed a little fun.
    
    print '*' x 40, $/;
    print
        "CGI::Ex::Recipes - Example application using$/"
        ."CGI::Ex::App - Anti-framework application framework.$/";
    print '*' x 40, $/;
    
    print "Using $Config{perlpath} " . $Config{version} . ' on ' . $Config{'osname'} . $/;
    print 'Using UTF8LOCALE - GOOOD!' . $/ if ${^UTF8LOCALE};
    $src  = realpath( rel2abs $self->{q}->param('src') ) || croak('Please provide source directory.'.$/.usage() );
    $dest = realpath( rel2abs $self->{q}->param('dest') )|| croak('Please provide destination directory.'.$/.usage());

    
    #check if $src and $dest are the same.
    if ( $src eq $dest ) {
        print
            "Source path:'$src'$/should not be the same as $/"
            . "destination path: '$dest'$/... exiting."
            . $/;
        exit;
    }
    
    #check if $dest is under $src

    #check if $src and $dest exist
    if(!-e $src || !-d $src){
        print "Source path: '$src'$/does not exists or is not a directory$/"
            ."... exiting.$/";
        exit;
    }
    if(!-e $dest){
        eval { mkpath($dest) };
        if ($@) {
            print "Couldn't create $dest:$/$@$/" . "... exiting.$/";
            exit;
        }
    }elsif(!-d $dest) {
        print "Destination path: $/'$dest'$/exists but is not a directory$/"
            ."... exiting.$/";
        exit;
    }
    ##############################
    #blah ... we can start work...
    ##############################
    $self->_install($src,$dest);
}# end sub install

sub _install {
    my $self = shift;
    print "Installing $src/* to $dest/*...$/";
    #sleep 1;
    finddepth(
        {   wanted => sub {
                
                my $file = $File::Find::name;
                if (-l $file){
                    warn "$/Found link '$file'... skipping $/";
                    return;
                }
                if ( $file !~ /\.svn/ )
                {
                    #wow
                    my $file_dest = $file;
                    $file_dest =~s/^$src/$dest/;
                    my $dest_dir = $File::Find::dir;
                    $dest_dir =~s/^$src/$dest/;
                    print "Copying $file $/"
                         ."to:     $file_dest" . $/;
                    if ( !-e $dest_dir ){ mkpath($dest_dir)  }
                    if (  -d $file     ){ mkpath($file_dest) }
                    if ( !-d $file     ){
                        copy( $file, $file_dest) or die "Copy failed: $!";
                        
                        if($file_dest =~/\.(pl|cgi)$/) {
                            chmod 0755,$file_dest and change_shebang_sitepackage_and_siteroot($file_dest);
                        }elsif($file_dest =~/(httpd\.conf)$/){
                            my $fh = IO::File->new("< $file_dest");
                            my @lines;
                            ( $fh->binmode and @lines =  $fh->getlines and $fh->close ) || die $!;
                            foreach ( 0 .. @lines-1 ) {
                               $lines[$_] =~ s|#Include (.*?)|#Include $dest|;
                                $lines[$_] =~ s|Directory "(.*?)"|Directory "$dest"| ;
                                $lines[$_] =~ s|PerlRequire\s+(.*?)/perl/bin/startup.pl|PerlRequire $dest/perl/bin/startup.pl|;

                            }
                            $fh = IO::File->new("> $file_dest");     
                            $fh->binmode and $fh->print(@lines) and $fh->close;
                        }
                        
                    }
                        #make (tmp|conf|logs|data|files) and below world writable so the server can write there
                        #TODO:think about a safer/smarter way
                        chmod 0777,$file_dest
                            if($file_dest =~/(tmp|conf|logs|data|files)/);
                        #TODO:REMEMBER to write a script which will change permissions as needed
                    #sleep 1;

                }
    
            },
            no_chdir => 1,
        },
        $src
    );


}#end sub _install

sub usage {
    'Usage:'.$/.$0 .' src=/from/path dest=/to/path'.$/;
}
sub change_shebang_sitepackage_and_siteroot {
    my ( $file ) = @_;
    my $fh = IO::File->new("< $file");
    my @lines;
    ( $fh->binmode and @lines =  $fh->getlines and $fh->close ) || die $!;
    my $new_shebang = "$Config{perlpath}".$Config{_exe};
    $new_shebang && $lines[0]=~ s/^#!\s*\S+/#!$new_shebang/s ;
    my $new_package = $dest; 
    $new_package =~ s|/|_|g;
    foreach ( 0 .. @lines-1 ) {
        $lines[$_]=~ s/package\s+ourobscurepackage/package $new_package/ ;
        $lines[$_]=~ s/\$ENV\{SITE_ROOT\}\s*?=.+/\$ENV\{SITE_ROOT\} = '$dest';/;
    }
    $fh = IO::File->new("> $file");     
    ( $fh->binmode and $fh->print(@lines) and $fh->close ) || die $!;
}


1;