view release on metacpan or  search on metacpan

CAF_MB_Installer.pm  view on Meta::CPAN

   caf_project_files # are installed in project subdirectory of user's webroot (e.g. /caf-examples/images)

   caf_server_files  # installed in caf framework directory.  Also, an an attempt is made
                     # to make these owned by the webserver

=cut


sub caf_add_examples_build_elements {
    my $self = shift;

    $self->add_build_element('caf_cgi');
    $self->add_build_element('caf_htdoc');
    $self->add_build_element('caf_image');
    $self->add_build_element('caf_config');
    $self->add_build_element('caf_project');
    $self->add_build_element('caf_server');
    $self->add_build_element('caf_sql');
}


# Override the install action to also install certain directories
# required by CAF at runtime.  These directories need to be writeable by
# the webserver, so an effort is made to change their ownership

sub ACTION_install {
    my $self = shift;
    $self->SUPER::ACTION_install(@_);

    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;
                },
            );