view release on metacpan or  search on metacpan

CAF_MB_Installer.pm  view on Meta::CPAN

    my $user  = $self->notes('examples_user_num');
    my $group = $self->notes('examples_group_num');

    $self->caf_install_example_files($self->caf_install_map, 1, $user, $group);

    $self->caf_fix_server_directories;
}

sub caf_fix_server_directories {
    my $self = shift;

    # after the regular install has completed,
    # install server directories (relative to destdir)

    return unless $self->notes('install-examples');

    my $verbose = $self->{properties}->{verbose};
    print "Installing Server Paths... \n" if $verbose;

    my @server_paths = (
        $self->notes('path_sqlite'),
        $self->notes('path_weblog'),
        $self->notes('path_session_dir'),
        $self->notes('path_session_locks'),
    );
    my @server_files = (
        $self->notes('file_sqlite_db'),
    );

    my $uid = $self->notes('web_server_user_num');
    my $gid = $self->notes('web_server_group_num');

    my $destdir = $self->{properties}{destdir} || '';

    foreach my $server_path (@server_paths) {

        if ($destdir) {
            # Need to remove volume from $map{$_} using splitpath, or else
            # we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
            my ($volume, $path) = File::Spec->splitpath( $server_path, 1 );
            $server_path = File::Spec->catdir($destdir, $path);
        }
    }
    foreach my $server_file (@server_files) {

        if ($destdir) {
            # Need to remove volume from $map{$_} using splitpath, or else
            # we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
            my ($volume, $path, $file) = File::Spec->splitpath( $server_file );
            $server_file = File::Spec->catdir($destdir, $path, $file);
        }
    }

    foreach my $server_path (@server_paths) {
        File::Path::mkpath($server_path, 0, 0777);
    }

    foreach my $server_path (@server_paths, @server_files) {

        # skip chown on Win32 - instead notify the user
        if ($^O =~ /Win32/) {
            print "Make sure this path is writeable by your webserver:\n\t$server_path\n";
            next;
        }

        print "making path writeable by webserver: $server_path\n" if $verbose;
        chown $uid, $gid, $server_path
            or warn "Could not make the following path writeable by the webserver - you'll have to do it manually:\n\t$server_path\n";

        # Make writeable
        my $current_mode = (stat $server_path)[2];
        chmod $current_mode | 0600, $server_path;
    }
}

sub find_caf_cgi_files      {  shift->_find_file_by_type('.*',                'caf_cgi'     ) }
sub find_caf_config_files   {  shift->_find_file_by_type('conf',              'caf_config'  ) }
sub find_caf_htdoc_files    {  shift->_find_file_by_type('(html?)|(css)',     'caf_htdoc'   ) }
sub find_caf_image_files    {  shift->_find_file_by_type('(png)|(jpg)|(gif)', 'caf_image'   ) }
sub find_caf_project_files  {  shift->_find_file_by_type('.*',                'caf_project' ) }
sub find_caf_server_files   {  shift->_find_file_by_type('.*',                'caf_server'  ) }
sub find_caf_sql_files      {  shift->_find_file_by_type('.*',                'caf_sql'     ) }

sub caf_type_is_static {
    my ($self, $ext) = @_;
    return 1 if $ext eq 'caf_project';
    return 1 if $ext eq 'caf_image';
    return 1 if $ext eq 'caf_server';
    return;
}

sub process_files_by_extension {
    my $self  = shift;
    my ($ext) = @_;

    # skip special processing for non-caf
    unless ($ext =~ /^caf_/) {
        return $self->SUPER::process_files_by_extension(@_);
    }

    my $method = "find_${ext}_files";
    my $files = $self->can($method) ? $self->$method() : $self->_find_file_by_type($ext,  'lib');

    while (my ($file, $dest) = each %$files) {

        my $source = $file;
        my $target = File::Spec->catfile($self->blib, $dest);

        return if $self->up_to_date($source, $target);

        # caf_images and caf_project are a simple copy
        if ($self->caf_type_is_static($ext)) {
            $self->copy_if_modified(from => $source, to => $target);
        }
        else {
            # Make parent directory
            File::Path::mkpath(File::Basename::dirname($target), 0, 0777);

            my $template = HTML::Template->new(
                filename          => $source,
                die_on_bad_params => 0,
                filter            => sub {
                    my $text_ref = shift;
                    # Convert !!- var -!! to <TMPL_VAR var>
                    $$text_ref =~ s/!!-\s*(.*?)\s*-!!/<TMPL_VAR "$1">/g;
                },
            );

CAF_MB_Installer.pm  view on Meta::CPAN

    foreach my $source_path (sort keys %$from_to) {

        my $targetroot = $from_to->{$source_path};

        chdir $source_path or next;

        File::Find::find(sub {
            my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
            return unless -f _;

            my $origfile = $_;
            return if $origfile eq ".exists";

            my $targetdir  = File::Spec->catdir(  $targetroot,  $File::Find::dir);
            my $targetfile = File::Spec->catfile( $targetdir,   $origfile);
            my $sourcedir  = File::Spec->catdir(  $source_path, $File::Find::dir);
            my $sourcefile = File::Spec->catfile( $sourcedir,   $origfile);

            my $save_cwd = Cwd::cwd;
            chdir $cwd;  # in case the target is relative
                         # 5.5.3's File::Find missing no_chdir option.

            my $diff = 0;
            if ( -f $targetfile && -s _ == $size) {
                # We have a good chance, we can skip this one
                $diff = File::Compare::compare($sourcefile, $targetfile);
            } else {
                print "$sourcefile differs\n" if $verbose>1;
                $diff++;
            }

            # TODO:
            # currently if the target file is the same as the source file,
            # the file is not installed.
            #
            # However, no check is made to see if the file metadata is wrong.
            # So you can't just run ./Build install to fix broken permissions -
            # you actually have to delete the target files.
            #
            # I'm not sure I understand the reason for the diff check anyway.
            # If the local file is different it is clobbered, so it can't be
            # about preserving local changes.
            #
            # So is it for performance or to conserve resources?  If so,
            # why bother?  This is just an install script that gets run very
            # rarely.  And it's exceptionally rare that the copying is skipped
            # because the files haven't changed.
            #
            # Anyway, for now, we go with the same behaviour that is in
            # ExtUtils::Install, but in the future, we may change.

            if ($diff){
                if (-f $targetfile){
                    forceunlink($targetfile);
                }
                else {
                    File::Path::mkpath($targetdir,0,0755);
                    print "mkpath($targetdir,0,0755)\n" if $verbose>1;

                    if ($user && $group) {
                        chown $user, $group, $targetdir;
                        print "chown($user, $group, $targetdir)\n" if $verbose>1;
                    }
                }
                File::Copy::copy($sourcefile, $targetfile);

                print "Installing $targetfile\n";

                utime($atime,$mtime + $is_vms, $targetfile);

                print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;

                # We don't change the mode of the files, since these are
                # example files and should be installed with permissions
                # that respect the users umask

                # However, if the original file was executable, make
                # the new file executable too

                my $executable = (stat $sourcefile)[2] & 0111;

                if ($executable) {
                    my $mode = (stat $targetfile)[2];
                    $mode = $mode | $executable;
		            chmod $mode, $targetfile;
		            print "chmod($mode, $targetfile)\n" if $verbose>1;
                }

                # MAG - allow changing ownership of installed files
                if ($user && $group) {
                    chown $user, $group, $targetfile;
                    print "chown($user, $group, $targetfile)\n" if $verbose>1;
                }

            }
            else {
                print "Skipping $targetfile (unchanged)\n" if $verbose;
            }

            # File::Find can get confused if you leave the directory it
            # placed you in so we chdir back to the directory it put us in.
            chdir $save_cwd;

        }, File::Spec->curdir);

        # After each copying run, return to the main directory
        chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
    }

}

# Tell MB where to install our special files
sub caf_install_map {
    my ($self, $blib) = @_;
    $blib ||= $self->blib;

    my %install_map;

    if ($self->notes('install-examples')) {

        my %caf_map = (
            'caf_cgi'     => $self->notes('path_examples_cgi_bin'),
            'caf_htdoc'   => $self->notes('path_examples_htdocs'),
            'caf_image'   => $self->notes('path_examples_images'),
            'caf_config'  => $self->notes('path_projects_dir'),
            'caf_project' => $self->notes('path_projects_dir'),
            'caf_server'  => $self->notes('path_framework_root'),
            'caf_sql'     => $self->notes('path_sql_dir'),
        );

        # Taken directly from Module::Build::Base
        if (length(my $destdir = $self->{properties}{destdir} || '')) {
            foreach (keys %caf_map) {
                # Need to remove volume from $map{$_} using splitpath, or else
                # we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
                my ($volume, $path) = File::Spec->splitpath( $caf_map{$_}, 1 );
                $caf_map{$_} = File::Spec->catdir($destdir, $path);
            }
        }

        foreach my $dir (keys %caf_map) {
            my $blib_dir = File::Spec->catdir($blib, $dir);
            $install_map{$blib_dir} = $caf_map{$dir};
        }
    }

    return \%install_map;
}

###################################################################
# User input methods
###################################################################