CGI-Application-Framework

 view release on metacpan or  search on metacpan

lib/CGI/Application/Framework.pm  view on Meta::CPAN

C<caf_example.pgsql>.  Load this into the PostgreSQL database. Type:

    psql -U some_user -f caf_example.pgsql example

This will create the C<example> database and one table with a
few pre-populated rows, C<users>, and a bunch of other empty tables.

Whatever you chose for some_username and a_password you must place these
into the configuration in your top-level framework.conf file:

    <db_example>
        dsn           = DBI:Pg:dbname=example
        username      = rdice
        password      = seekrit
    </db_example>

For more information on the format of the 'dsn' parameter, consult the
C<DBD:Pg> documentation:

    http://search.cpan.org/~dbdpg/DBD-Pg-1.40/Pg.pm

The C<caf_example.pgsql> file does not contain all of the data needed in
order to populate the database with seed data for all of the example
programs of the Framework.  To load the rest of the data, do the
following:

    # cd framework/sql/
    # ./load_music_data.pl music_info.csv

This data is stored in a seperate file and comes with its own loading
program, so that you can see more examples of how the CDBI modules is
used to accomplish real-life tasks.  Inspect the contents of the
C<load_music_data.pl> file to see how it works.


=head2 Database Installation - SQLite

This is how to create a SQLite database that works with the Example
applications.

SQLite is a complete SQL database contained in a C<DBD> driver.  This means
you can use it on machines that aren't running a database server.

Each SQLite database is contained in its own file.  Database permissions are
managed at the filesystem level.  Both the file and the directory that
contains it must be writable by any users that want to write any data to
the database.

The SQLite database and directory should have been created by the CAF
installation script.  However these instructions also apply to SQLite
databases you create for other projects.

Create a directory to contain the SQLite databases:

    $ mkdir /home/rdice/Framework/sqlite

Change its permissions so that it is writeable by the group the
webserver runs under:

    # chown .web /home/rdice/Framework/sqlite
    # chmod g+w /home/rdice/Framework/sqlite

Add the group "sticky" bit so that files created in this directory
retain the group permissions:

    # chmod g+s /home/rdice/Framework/sqlite

Now import the example database shema.

SQLite does not come with a command line shell.  Instead, use the
dbish program which is installed as part of the C<DBI::Shell> module.

    dbish --batch dbi:SQLite:dbname=/home/rdice/Framework/sqlite/sqlite_db < caf_example.sqlite

This will create the C<example> database and one table with a
few pre-populated rows, C<users>, and a bunch of other empty tables.

Whatever you chose for some_username and a_password you must place these
into the configuration in your top-level framework.conf file:

    <db_example>
        dsn           = DBI:SQLite:dbname=/home/rdice/Framework/sqlite
        username      = rdice
        password      = seekrit
    </db_example>

For more information on the format of the 'dsn' parameter, consult the
C<DBD::SQLite> documentation:

    http://search.cpan.org/~msergeant/DBD-SQLite-1.08/lib/DBD/SQLite.pm

The caf_example.sqlite file does not contain all of the data needed in
order to populate the database with seed data for all of the example
programs of the Framework.  To load the rest of the data, do the
following:

    # cd framework/sql/
    # perl ./load_music_data.pl music_info.csv

This data is stored in a seperate file and comes with its own loading
program, so that you can see more examples of how the CDBI modules is
used to accomplish real-life tasks.  Inspect the contents of the
C<load_music_data.pl> file to see how it works.


=cut


sub login {

    my $self = shift;

    my $config = $self->conf($self->config_name)->context;

    $self->log->debug("At top of 'login' subroutine / run mode ");
    # ------------------------------------------------------------------
    # Note that the '_errs' param will be populated if there was
    # an error with the processing of a login form submission; this is a
    # CGI::Application::Plugin::ValidateRM ->check_rm method thing,
    # called from within the 'cgiapp_prerun' subroutine.  There are
    # tmpl_var fields within the .tmpl loaded below that correspond to
    # the entries named in $err.  After reading it, unset it so that
    # it isn't polluted with information the next time this sub is
    # accessed.
    # ------------------------------------------------------------------
    my $errs = shift || $self->_param_read_and_unset('_errs');

lib/CGI/Application/Framework.pm  view on Meta::CPAN


                return;
                # -------------------------------------------------------
            }

        } else {

            $self->log->debug("Looks like we didn't come from 'relogin'");

            if ( $self->_relogin_test() ) {

                # ------------------------------------------------------
                # no problems with time-out check, so continue with
                # web application run...
                # ------------------------------------------------------
                return; # these aren't the droids we're looking for
                # ------------------------------------------------------

            } else {

                # ------------------------------------------------------
                # The session time-out'd, therefore make them cough up a
                # new password, first by redirecting them to a form.
                #
                # Note that the state of the $self-query is saved in
                # the session, so that it may be reconstituted later,
                # for the sake of figuring out where the submit-to
                # run mode was supposed to be, so that form submission
                # data is not lost due to a timeout, etc.
                # ------------------------------------------------------
                my $session_query = '';
                {
                    local $Data::Dumper::Indent = 0;
                    # local $Data::Dumper::Useqq  = 1;  # this creates problems
                    $session_query
                        = Data::Dumper->Dump([$self->query], [ '$query' ]);
                }
                $session_query =~ s/\$query = //;
                $session_query =~ s/;$//;
                $self->session->{_cgi_query} = $session_query;
                $self->prerun_mode('relogin');
                return;
                # ------------------------------------------------------

            } # end of if $self->_relogin_test
        }
    }

    return; # guess that's about it...
}


# ------------------------------------------------------------------
# These methods are new and unique to CGI::Application::Framework
# ------------------------------------------------------------------
sub _make_run_mode_tag {

    my $self   = shift;
    my %params = @_;

    my $whichmode = undef;

    if ( $params{whichmode} eq 'COMEFROM' ) {
        $whichmode = 'come_from_' . $self->mode_param();
    } elsif ( $params{whichmode} eq 'CURRENT' ) {
        $whichmode = 'current_' . $self->mode_param();
    } elsif ( $params{whichmode} eq 'SUBMITTO' ) {
        $whichmode = $self->mode_param();
    } else {
        $self->log_confess("Unsupported run mode [$params{whichmode}] ");
    }

    return
        '<input type=hidden name="'
        . $whichmode
        . '" value="'
        . $self->query->escapeHTML($params{modevalue})
        . '">';
}

sub _param_read_and_set {

    my $self = shift;
    my $param = shift;

    my $value = $self->param($param);
    $self->param($param => ($value || 1));
    return $value;
}

sub _param_read_and_unset {

    my $self = shift;
    my $param = shift;

    my $value = $self->param($param);
    $self->param($param => undef);
    return $value;
}

sub make_self_url {

    my $self = shift;

    # -----------------------------------------------------------------------
    # I had to do all this ugly stuff to create a URL + query string
    # (the latter if necessary) because a simple $self->query->url(-query=>1)
    # was doing weird stuff, like joining key/value pairs with ';' instead
    # of '&', and building the query string out of the full form submission,
    # rather than just with stuff that's just in the query string) even when
    # the form method was POST. (!?!)
    # -----------------------------------------------------------------------
    my $self_url = $self->query->url();
    if ( $ENV{PATH_INFO} ) {
        $self_url .= $ENV{PATH_INFO};
    }
    if ( $ENV{QUERY_STRING} ) {
        $self_url .= '?' . $ENV{QUERY_STRING};
    }
    # -----------------------------------------------------------------------

    return $self_url;
}

sub get_session_id {

    my $self = shift;

    if ( $self->query->cookie('session_id') ) {
        $self->param( session_state => SESSION_IN_COOKIE );
        return $self->query->cookie('session_id');
    }

    if ( $self->query->url_param('_session_id') ) {
        $self->param( session_state => SESSION_IN_URL );

lib/CGI/Application/Framework.pm  view on Meta::CPAN


    # -----------------------------------------------------------------
    # Recompute a new checksum with the public info found and the
    # same secret key used to make the original checksum.
    # -----------------------------------------------------------------
    my $recomputed_checksum = Digest::MD5::md5_hex
        (
         Digest::MD5::md5
         ($complete_url . $config->{'md5_salt'})
         );
    # -----------------------------------------------------------------
    # print STDERR "complete_url: $ENV{PATH_INFO}; checksum: $checksum; recomputed: $recomputed_checksum\n";

    # -----------------------------------------------------------------
    # If the recomputed checksum is the same as the retrieved checksum
    # then success!
    # -----------------------------------------------------------------
    return 1 if $recomputed_checksum eq $checksum;
    # -----------------------------------------------------------------
    # print STDERR "4.here\n";
    return 0;
}

# -------------------------------------------------------------------
# The "session" subroutine enables the $self->session->{'foobar'}
# syntax, rather than the bulkier $self->param('session')->{'foobar'}
# -------------------------------------------------------------------
sub session {
    my $self = shift;
    return $self->param('session') || undef;
}


# -------------------------------------------------------------------
# _framework_template_pre_process is called right before a template is
# rendered. It is called with the $template object as its first parameter.
#
# The job of this callback is to modify any of the parameters to the
# template before it gets filled.
#
# The system needs certain parameters set (such as the run mode tags, the
# SESSION_STATE, etc.).
#
# -------------------------------------------------------------------

sub _framework_template_pre_process {
    my ($self, $template) = @_;

    # Change the internal template parameters by reference
    my $params = $template->get_param_hash;

    # Add the public configuration params to all templates
    $template->param(scalar $self->conf->context);

    $params->{'SESSION_STATE'} = $self->_make_hidden_session_state_tag;

    if ( $params->{'run_mode_tags'} ) {
    	foreach my $tag ( keys %{$params->{'run_mode_tags'}} ) {
            $params->{$tag} = $self->_make_run_mode_tag
             (
              whichmode => $params->{'run_mode_tags'}->{$tag}->[0],
              modevalue => $params->{'run_mode_tags'}->{$tag}->[1],
              );
        }
    }
}

# -------------------------------------------------------------------
# _framework_template_pre_process is called right after a template is
# rendered. It is called with the $template object as its first parameter,
# and a reference to the output text as its second parameter.
#
# The job of this callback is to modify the text generated by the template
# engine.
#
# By default the system adds comments to the beginning and ending of every
# template indicating the filename of the template.  This is useful for
# debugging purposes.
#
# -------------------------------------------------------------------

sub _framework_template_post_process {
    my ($self, $template, $output_ref) = @_;

    if ( $self->conf->context->{'output_file_name_comment'} ) {
        my $fullfilepath = $template->filename;

        $$output_ref = "<!-- begin template file [[$fullfilepath]] -->"
                     . $$output_ref
                     . "<!-- end template file [[$fullfilepath]] -->";
    }
}

sub redirect {

    my $self = shift;
    my $location = shift;

    $self->header_add(-location => $location);
    $self->header_type('redirect');

    return "";
}


=head1 AUTHOR

The primary author of CGI::Application::Framework is Richard Dice,
C<< <rdice@pobox.com> >>, though Michael Graham is right up there,
too.  (Most of Michael's CAP::* modules created over the past few months
have been the result of refactoring code out of CAF and putting it online
in chunks small and modular enough to be used by other CGI::App programmers
and their applications.)

=head1 BUGS

Please report any bugs or feature requests to
C<bug-cgi-application-framework@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.  I will be notified, and then you'll automatically
be notified of progress on your bug as I make changes.



( run in 0.867 second using v1.01-cache-2.11-cpan-39bf76dae61 )