/[webpac2]/Webpacus/lib/Webpacus.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /Webpacus/lib/Webpacus.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 440 - (hide annotations)
Sun Apr 30 23:20:12 2006 UTC (18 years ago) by dpavlin
File size: 2806 byte(s)
 r538@llin:  dpavlin | 2006-05-01 01:20:34 +0200
 first rough cut to implement pager using Data::SpreadPagination

1 dpavlin 83 package Webpacus;
2    
3     use strict;
4     use warnings;
5    
6     #
7     # Set flags and add plugins for the application
8     #
9     # -Debug: activates the debug mode for very useful log messages
10     # Static::Simple: will serve static files from the applications root directory
11     #
12 dpavlin 93 use Catalyst qw/-Debug
13     Prototype
14     Config::YAML
15 dpavlin 100 FillInForm
16 dpavlin 207 SubRequest
17 dpavlin 228 Static::Simple
18 dpavlin 348 StackTrace
19 dpavlin 399 Dumper
20 dpavlin 93 /;
21 dpavlin 97 # FormValidator
22 dpavlin 83
23 dpavlin 440 our $VERSION = '0.35-dev';
24 dpavlin 83
25     #
26     # Configure the application
27     #
28 dpavlin 93 __PACKAGE__->config(
29     name => 'Webpacus',
30     config_file => 'config.yml',
31     );
32 dpavlin 83
33     #
34     # Start the application
35     #
36     __PACKAGE__->setup;
37    
38     =head1 NAME
39    
40     Webpacus - Catalyst based application
41    
42     =head1 SYNOPSIS
43    
44     script/webpacus_server.pl
45    
46     =head1 DESCRIPTION
47    
48     Catalyst based application.
49    
50     =head1 METHODS
51    
52     =over 4
53    
54     =item default
55    
56     =cut
57    
58     sub default : Private {
59     my ( $self, $c ) = @_;
60     $c->stash->{template} = 'index.tt';
61 dpavlin 358
62 dpavlin 422 my $site_name = shift @{ $c->req->args } || '';
63 dpavlin 358
64 dpavlin 359 $c->log->debug("trying site name: $site_name");
65    
66 dpavlin 358 if (my $sites_root = $c->config->{sites_root}) {
67     my $site_path = $c->path_to('root', $sites_root, $site_name);
68    
69     if (-e $site_path) {
70     $c->stash->{site} = $site_name;
71 dpavlin 359 if (my $action = join('/', @{ $c->req->args })) {
72 dpavlin 358 $c->log->debug( "site: $site_name, action: $action" );
73 dpavlin 399 # do a subrequest
74     $c->res->body( $c->subreq( $action, $c->stash, @{ $c->req->args } ) );
75 dpavlin 358 } else {
76     $c->log->debug( "site: $site_name" );
77     }
78     } else {
79     $c->log->debug( "can't find site $site_name in $site_path");
80     }
81     } else {
82     $c->log->warn("sites_root not defined in config");
83     }
84 dpavlin 83 }
85    
86     =item end
87    
88     =cut
89    
90     sub end : Private {
91     my ( $self, $c ) = @_;
92    
93 dpavlin 139 $c->stash->{webpacus_version} = $VERSION;
94    
95 dpavlin 228 if ($c->response->body) {
96     $c->log->debug("at end body exists, we won't touch it!");
97     } else {
98 dpavlin 358 if (my $site_name = $c->stash->{site}) {
99     my $template_path = $c->path_to('root', $c->config->{sites_root}, $site_name, $c->stash->{template});
100     if (-e $template_path) {
101     $c->stash->{template} = $c->config->{sites_root} . "/$site_name/" . $c->stash->{template};
102     } else {
103     $c->log->warn("can't find $template_path, fallback to default");
104     }
105 dpavlin 399 $c->log->debug("using template " . $c->stash->{template});
106    
107     $c->stash->{site_url} = "/$site_name/";
108    
109 dpavlin 405 #$c->log->dumper( $c->stash, 'stash' );
110 dpavlin 399
111 dpavlin 358 }
112    
113 dpavlin 270 # Forward to View unless response body is already defined
114     $c->forward('View::TT');
115 dpavlin 100
116 dpavlin 387 $c->fillform( $c->req->params );
117    
118 dpavlin 270 $c->response->{body} =~ s#\Qnew Ajax.Autocompleter(\E#new WebPAC.Suggest(#gs;
119     $c->response->{body} =~ s#\Qnew Ajax.Updater(\E#new WebPAC.Updater(#gs;
120    
121     # $c->log->debug( $c->response->body );
122 dpavlin 228 }
123 dpavlin 97
124 dpavlin 83 }
125    
126     =back
127    
128     =head1 AUTHOR
129    
130 dpavlin 203 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
131 dpavlin 83
132     =head1 LICENSE
133    
134     This library is free software, you can redistribute it and/or modify
135     it under the same terms as Perl itself.
136    
137     =cut
138    
139     1;

  ViewVC Help
Powered by ViewVC 1.1.26