view release on metacpan or  search on metacpan

erecipes/perl/lib/CGI/Ex/Recipes/Install.pm  view on Meta::CPAN

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

    #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;