[Openinteract-commits] CVS: OpenInteract/pkg/base_page/OpenInteract/Handler Page.pm,NONE,1.1

[Chris W. <la...@us...>]

Update of /cvsroot/openinteract/OpenInteract/pkg/base_page/OpenInteract/Handler
In directory usw-pr-cvs1:/tmp/cvs-serv12876/OpenInteract/Handler

Added Files:
	Page.pm 
Log Message:
beginning of rewritten static_page handler (DOES NOT WORK YET)


--- NEW FILE: Page.pm ---
package OpenInteract::Handler::Page;

# $Id: Page.pm,v 1.1 2001/10/20 15:12:15 lachoy Exp $

use strict;
use Class::Date ();
use OpenInteract::CommonHandler qw( OK ERROR );
use OpenInteract::Handler::GenericDispatcher qw( DEFAULT_SECURITY_KEY );
use SPOPS::Secure qw( :level );

@OpenInteract::Handler::BasePage::ISA     = qw( OpenInteract::CommonHandler  SPOPS::Secure );
$OpenInteract::Handler::BasePage::VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$OpenInteract::Handler::BasePage::author            = 'ch...@cw...';
$OpenInteract::Handler::BasePage::default_method    = 'show';
@OpenInteract::Handler::BasePage::forbidden_methods = ();
%OpenInteract::Handler::BasePage::security          = (
   DEFAULT_SECURITY_KEY() => SEC_LEVEL_WRITE,
   show   => SEC_LEVEL_NONE, notify  => SEC_LEVEL_READ,
);

use constant MAIN_SCRIPT     => '/Page';

# Use this to signal that we shouldn't send the content through TT --
# this is useful for documentation :-)

use constant NO_PARSE_STATUS => 'no_parse';

# 52 weeks -- default expiration for page

use constant DEFAULT_EXPIRE  => 60 * 60 * 24 * 7 * 52;

# Use this to mark the beginning and end of the "good" content in a
# page in the filesystem; this allows you to use an HTML editor to
# create the content and to save a full html page to the filesystem

my $BODY_DEMARCATION = '<!-- OI BODY -->';

# Use this to check whether the file retrieved is displayable in the
# browser; others (pdf, ps, mov, etc.) get sent to the user directly

my %DISPLAY_TYPES = map { $_ => 1 } ( 'text/html', 'text/plain', 'text/xml' );

# Use this to separate your single document into multiple pages

my $PAGE_SEPARATOR = '<!--PAGE-->';


sub MY_PACKAGE                 { return 'base_page' }
sub MY_HANDLER_PATH            { return '/Page' }
sub MY_OBJECT_TYPE             { return 'page' }
sub MY_OBJECT_CLASS            { return OpenInteract::Request->instance->page }
sub MY_SEARCH_FIELDS           { return () }
sub MY_OBJECT_FORM_TITLE       { return 'Edit Page' }
sub MY_OBJECT_FORM_TEMPLATE    { return '' }
sub MY_EDIT_RETURN_URL         { return '/' }
sub MY_EDIT_DISPLAY_TASK       { return 'show' }
sub MY_EDIT_FIELDS             { return qw( location title author keywords
                                            boxes main_template notes ) }
sub MY_EDIT_FIELDS_TOGGLED     { return qw( is_active is_file ) }
sub MY_EDIT_FIELDS_DATE        { return qw( active_on expires_on ) }
sub MY_ALLOW_SEARCH_FORM       { return 1 }
sub MY_ALLOW_SEARCH            { return 1 }
sub MY_ALLOW_EDIT              { return 1 }
sub MY_ALLOW_REMOVE            { return 1 }
sub MY_ALLOW_WIZARD            { return undef }


# Overrides entry in OpenInteract::Handler::GenericDispatcher

sub _get_task {
    my ( $class ) = @_;
    my $R = OpenInteract::Request->instance;
    return 'show'  if ( $R->{path}{full}->[0] ne 'Page' );
    return lc shift @{ $R->{path}{current} } ||
           $OpenInteract::Handler::Page::default_method;
}



# Retrieve all directories, expanding the one we were asked to (if at
# all). Note that these are just the objects in the database, although
# hopefully there's one of these corresponding to every file in the
# filesystem.

sub listing {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;

    my $selected_dir = $R->apache->param( 'selected_dir' );
    my $params = { selected_dir => $selected_dir,
                   error_msg    => $p->{error_msg} };

    $params->{dir_list} = eval { $R->page->list_directories };
    if ( $@ ) {
        OpenIntereact::Error->set( SPOPS::Error->get );
        $R->throw({ code => 403 });
        $params->{dir_list} = [];
    }

    # Store the pages found using the directory as a key pointing to a
    # listref of files it contains

    if ( $selected_dir ) {
        $params->{children_files} = $R->static_page->fetch_iterator({
                                               where => 'directory = ?',
                                               value => [ $selected_dir ] });
    }

    $R->{page}{title} = 'Listing of Documents';
    return $R->template->handler( {}, $params,
                                  { name => 'page::page_directory_list' } );
}


sub show {
    my ( $class, $p ) = @_;
    my $R = OpenInteract::Request->instance;
    my $params = { main_script => MAIN_SCRIPT,
                   error_msg   => $p->{error_msg},
                   status_msg  => $p->{status_msg} };

    my $location   = $class->_clean_location( $class->_find_location( $p ) );
    my $page       = eval { $p->{page} || $class->_find_page_object( $location ) };
    my $error_type = $@;
    my $do_edit    = ( $R->apache->param( 'edit' ) and
                       $p->{level} >= SEC_LEVEL_WRITE );

    unless ( $page or $do_edit ) {
        $R->DEBUG && $R->scrib( 1, "",
                                   "Error type: ($error_type)" );

        # We have to force the content-type here because the user
        # might have requested a file that actually exists in the
        # filesystem and which Apache has already mapped a
        # content-type. You'll know when this happens because you'll
        # be prompted to d/l the file or a plugin (like Acrobat
        # Reader) will try to display it, but the *actual* content
        # will be plain old HTML...

        $R->{page}{content_type} = 'text/html';

        if ( $error_type =~ /^security/ ) {
            my $admin_email = $R->CONFIG->{mail}{admin_email};
            return <<FORBID;
<h2>Access Forbidden</h2>
<p>You do not have access rights to view this page.  Please e-mail the
administrator at <a href="mailto:$admin_email">$admin_email</a> if you
feel you have received this message in error.</p>
FORBID
        }
        elsif ( $error_type =~ /^access/ ) {
            return "<h2>Cannot Access</h2><p>Failure accessing page.</p>";
        }
        return <<NOTFOUND;
<h2>Page Not Found</h2>
<p>Could not find page with location you requested
(<tt>$location</tt>). Did you mistype the address?</p>
NOTFOUND
    }

    # If we specified that we're going to send a separate file to the
    # user (usually not HTML, text, etc.) then set the information and
    # quit processing

    unless ( $class->_is_page_displayable( $page ) ) {
        $R->{page}{send_file} = $page->{location};
        $R->DEBUG && $R->scrib( 1, "File being retrieved is not displayable.",
                                   "Set 'send_file' to $page->{location}" );
        return undef;
    }

    # We have a page and we can display it, so grab the content

    $page->load_content;

    # Now figure out if we're editing or not

    # Now we have a page; just check to see if we were instructed to
    # display the editable form for this page, and if so ensure this
    # user can do so.

    my $text_params = {};

    if ( $do_edit ) {
        $page ||= $R->page->new;
        $params->{page} = $page;
        $text_params = { name => 'page::page_form' };
        $R->{page}{title}   = 'Edit a Document';
        my $update_items = ( $page->is_saved ) ? eval { $page->fetch_updates( 5 ) } : [];
        foreach my $update_info ( @{ $update_items } ) {
            my $user = eval { $R->user->fetch( $update_info->[0] ) };
            my $username = ( $user ) ? $user->{login_name} : 'administrator';
            push @{ $params->{update_list} }, { login_name => $username, date => $update_info->[1] };
        }
    }
    else {

        # Ensure the page is viewable right now

        unless ( $class->_is_active( $page ) ) {
            $R->DEBUG && $R->scrib( 1, "Page is not currently active; return error" );
            $R->{page}{title} = 'Page not yet active';
            return '<h2 align="center">Not Active</h2><p>Sorry, this page is not currentlyactive.</p>';
        }

        $R->{page}{title}   = $page->{title};

        # Allows the page to define the main template it will use; if
        # the page doesn't define one then the main UI module will use
        # the default

        $R->{page}{_template_name_} = $page->{main_template};

        # You can split your page into multiple viewable pages -- see
        # _split_pages() for more info

        $text_params = $class->_split_pages( $page );
        $class->_add_object_boxes( $page, $p );
    }

    # If the page has told us not to run it through TT, just return
    # its content.

    if ( $page->{_template_status} eq NO_PARSE_STATUS ) {
        return $page->{content};
    }

    return $R->template->handler( {}, $params, $text_params );
}


sub _is_page_displayable {
    my ( $class, $page ) = @_;
    return 1 unless ( $page->{mime_type} );
    return 1 if ( $DISPLAY_TYPES{ $page->{mime_type} } );
    return undef;
}


# Find the location from whatever paramters, information we need

sub _find_location {
    my ( $class, $p ) = @_;
    return $p->{page}{location} if ( $p->{page} );
    my $R = OpenInteract::Request->instance;
    return $p->{location} ||
           $R->apache->param( 'location' ) ||
           $R->{path}{original};
}


# Security -- remove all '.' from the beginning of the location
# requested so people don't try to go up the directory tree. Also
# remove any two-dot sequence.
#
# In the future we might flag these as bad requests (die from here)
# and simply bail with a stern scoling.

sub _clean_location {
    my ( $class, $location ) = @_;
    return undef unless ( $location );
    $location =~ s/^\.+//;
    $location =~ s/\.\./_/;
    return $location;
}


# Find object with $location in the database. We also try to do the
# work so that you can request a directory index ('home',
# 'index.html', etc.);

sub _find_page_object {
    my ( $class, $location ) = @_;
    my $R = OpenInteract::Request->instance;
    $R->DEBUG && $R->scrib( 1, "Trying to retrieve object with location ($location)" );

    # Chop off any query strings and put in a case-consistent format

    $location    = $class->_remove_query_string( $location );
    $location    = lc $location;

    # Just like 'DirectoryIndex' in Apache...

    my $index_names = $R->CONFIG->{action}{page}{directory_index} || [];
    $R->DEBUG && $R->scrib( 1, "Using the following for index names: ",
                               join( ', ', @{ $index_names } ) );

    my @locations = ( $location );
    if ( $location =~ m|/$| ) {
        $R->DEBUG && $R->scrib( 1, "Explicit directory request; add indexes" );
        push @locations, map { "$location$_" } @{ $index_names };
    }
    elsif ( $location !~ /\.\w+$/ ) {
        $R->DEBUG && $R->scrib( 1, "Location has no extension; add indexes " ),
        push @locations, map { "$location/$_" } @{ $index_names };
    }
    else {
        my ( $sans_extension );
        ( $sans_extension = $location ) =~ s/\.\w+$//;
        $R->DEBUG && $R->scrib( 1, "Also check location without the extension ",
                                  "using $sans_extension" );
        push @locations, $sans_extension;
    }

    my ( $page );
    my ( $error_type );
    foreach my $location ( @locations ) {
        $page = eval { $R->page->fetch( $location ) };
        if ( $@ ) {
            $R->scrib( 0, "Encountered error trying to retrieve ($location);",
                          "continuing with other locations." );
            $error_type = SPOPS::Error->get->{type};
        }
        return $page if ( $page );
    }
    return undef unless ( $error_type );
    die $error_type;
}


sub _remove_query_string {
    my ( $class, $text ) = @_;
    $text =~  s|^(.*)\?.*$|$1|;
    return $text;
}


sub _split_pages {
    my ( $class, $page ) = @_;
    my $R = OpenInteract::Request->instance;

    # Split the page into separate pages -- first check and see if the
    # document IS paged, then do the splitting and other contortions

    if ( $page->{content} =~ /$PAGE_SEPARATOR/ ) {
        my @text_pages      = split /$PAGE_SEPARATOR/, $page->{content};
        my $page_num        = $R->apache->param( 'pagenum' ) || 1;
        my $this_page       =  $text_pages[ $page_num - 1 ];
        my $total_pages     = scalar @text_pages;
        my $current_pagenum = $page_num;
        $this_page .= <<PCOUNT;
     <p align="right"><font size="-1">
     [% OI.comp( 'page_count', total_pages     = $total_pages,
                               url             = '$page->{location}',
                               current_pagenum = $current_pagenum ) %]
     </font></p>
PCOUNT
       return { text => $this_page };
    }
    return { text => $page->{content} };
}


sub _add_object_boxes {
    my ( $class, $page, $p ) = @_;
    my $R = OpenInteract::Request->instance;

    my $box_string = $page->{boxes};

    # If this page has specified any boxes, push them onto the stack
    # unless they start with a '-', in which case set that name aside
    # so we can go through all of the boxes and remove it.

    my %box_remove = ();
    if ( $box_string ) {
        my @boxes = split /\s+/, $box_string;
        foreach my $box_name ( @boxes ) {
            next if ( $box_name =~ /^\s*$/ );
            $R->DEBUG && $R->scrib( 1, "Adding box name ($box_name) from page definition" );
            if ( $box_name =~ s/^\-// ) {
                $box_remove{ $box_name }++;
            }
            else {
                push @{ $R->{boxes} }, $box_name;
            }
        }

        # Go through ALL the boxes and do a removal if necessary

        # TODO: we should move this processing to base_box)

        my @box_keep = ();
        foreach my $box_info ( @{ $R->{boxes} } ) {
            next if ( ref $box_info and $box_remove{ $box_info->{name} } );
            next if ( ! ref $box_info and $box_remove{ $box_info } );
            push @box_keep, $box_info;
        }
        $R->{boxes} = \@box_keep;
    }

    # If this person has WRITE access to the module, give them a box
    # so they can edit/remove this document

    if ( $p->{level} >= SEC_LEVEL_WRITE ) {
        push @{ $R->{boxes} }, { name   => 'edit_document_box',
                                 params => { location => $page->{location} } };
    }
    return undef;
}


sub _is_active {
    my ( $class, $page ) = @_;

    return undef if ( $page->{is_active} eq 'no' );
    return 1 unless ( $page->{active_on} );

    my $active  = Class::Date::date([ split '-', $page->{active_on} ]);
    my $now     = Class::Date->now;
    my $expires = Class::Date::date([ split '-', $page->{expires_on} ]);

    my $R = OpenInteract::Request->instance;
    $R->DEBUG && $R->scrib( 1, "Active on: $active; Expires on: $expires" );

    return undef if ( $now < $active );
    return undef if ( $now > $expires );
    return 1;
}


sub _edit_customize {
}



1;