source: trunk/lib/OpenGuides/CGI.pm @ 578

Last change on this file since 578 was 578, checked in by Dominic Hargreaves, 17 years ago

copyright updates.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.2 KB
Line 
1package OpenGuides::CGI;
2use strict;
3use vars qw( $VERSION );
4$VERSION = '0.06';
5
6use Carp qw( croak );
7use CGI::Cookie;
8
9=head1 NAME
10
11OpenGuides::CGI - An OpenGuides helper for CGI-related things.
12
13=head1 DESCRIPTION
14
15Does CGI stuff for OpenGuides.  Distributed and installed as part of
16the OpenGuides project, not intended for independent installation.
17This documentation is probably only useful to OpenGuides developers.
18
19=head1 SYNOPSIS
20
21Saving preferences in a cookie:
22
23  use Config::Tiny;
24  use OpenGuides::CGI;
25  use OpenGuides::Template;
26  use OpenGuides::Utils;
27
28  my $config = Config::Tiny->read( "wiki.conf" );
29
30  my $cookie = OpenGuides::CGI->make_prefs_cookie(
31      config                     => $config,
32      username                   => "Kake",
33      include_geocache_link      => 1,
34      preview_above_edit_box     => 1,
35      latlong_traditional        => 1,
36      omit_help_links            => 1,
37      show_minor_edits_in_rc     => 1,
38      default_edit_type          => "tidying",
39      cookie_expires             => "never",
40      track_recent_changes_views => 1,
41  );
42
43  my $wiki = OpenGuides::Utils->make_wiki_object( config => $config );
44  print OpenGuides::Template->output( wiki     => $wiki,
45                                      config   => $config,
46                                      template => "preferences.tt",
47                                      cookies  => $cookie
48  );
49
50  # and to retrive prefs later:
51  my %prefs = OpenGuides::CGI->get_prefs_from_cookie(
52      config => $config
53  );
54
55Tracking visits to Recent Changes:
56
57  use Config::Tiny;
58  use OpenGuides::CGI;
59  use OpenGuides::Template;
60  use OpenGuides::Utils;
61
62  my $config = Config::Tiny->read( "wiki.conf" );
63
64  my $cookie = OpenGuides::CGI->make_recent_changes_cookie(
65      config => $config,
66  );
67
68=head1 METHODS
69
70=over 4
71
72=item B<make_prefs_cookie>
73
74  my $cookie = OpenGuides::CGI->make_prefs_cookie(
75      config                     => $config,
76      username                   => "Kake",
77      include_geocache_link      => 1,
78      preview_above_edit_box     => 1,
79      latlong_traditional        => 1,
80      omit_help_links            => 1,
81      show_minor_edits_in_rc     => 1,
82      default_edit_type          => "tidying",
83      cookie_expires             => "never",
84      track_recent_changes_views => 1,
85  );
86
87Croaks unless a L<Config::Tiny> object is supplied as C<config>.
88Acceptable values for C<cookie_expires> are C<never>, C<month>,
89C<year>; anything else will default to C<month>.
90
91=cut
92
93sub make_prefs_cookie {
94    my ($class, %args) = @_;
95    my $config = $args{config} or croak "No config object supplied";
96    croak "Config object not a Config::Tiny"
97        unless UNIVERSAL::isa( $config, "Config::Tiny" );
98    my $cookie_name = $class->_get_cookie_name( config => $config );
99    my $expires;
100    if ( $args{cookie_expires} and $args{cookie_expires} eq "never" ) {
101        # Gosh, a hack.  YES I AM ASHAMED OF MYSELF.
102        # Putting no expiry date means cookie expires when browser closes.
103        # Putting a date later than 2037 makes it wrap round, at least on Linux
104        # I will only be 62 by the time I need to redo this hack, so I should
105        # still be alive to fix it.
106        $expires = "Thu, 31-Dec-2037 22:22:22 GMT";
107    } elsif ( $args{cookie_expires} and $args{cookie_expires} eq "year" ) {
108        $expires = "+1y";
109    } else {
110        $args{cookie_expires} = "month";
111        $expires = "+1M";
112    }
113    # Supply 'default' values to stop CGI::Cookie complaining about
114    # uninitialised values.  *Real* default should be applied before
115    # calling this method.
116    my $cookie = CGI::Cookie->new(
117        -name  => $cookie_name,
118        -value => { user       => $args{username} || "",
119                    gclink     => $args{include_geocache_link} || 0,
120                    prevab     => $args{preview_above_edit_box} || 0,
121                    lltrad     => $args{latlong_traditional} || 0,
122                    omithlplks => $args{omit_help_links} || 0,
123                    rcmined    => $args{show_minor_edits_in_rc} || 0,
124                    defedit    => $args{default_edit_type} || "normal",
125                    exp        => $args{cookie_expires},
126                    trackrc    => $args{track_recent_changes_views} || 0,
127                  },
128        -expires => $expires,
129    );
130    return $cookie;
131}
132
133=item B<get_prefs_from_cookie>
134
135  my %prefs = OpenGuides::CGI->get_prefs_from_cookie(
136      config => $config
137  );
138
139Croaks unless a L<Config::Tiny> object is supplied as C<config>.
140Returns default values for any parameter not specified in cookie.
141
142=cut
143
144sub get_prefs_from_cookie {
145    my ($class, %args) = @_;
146    my $config = $args{config} or croak "No config object supplied";
147    croak "Config object not a Config::Tiny"
148        unless UNIVERSAL::isa( $config, "Config::Tiny" );
149    my %cookies = CGI::Cookie->fetch;
150    my $cookie_name = $class->_get_cookie_name( config => $config );
151    my %data;
152    if ( $cookies{$cookie_name} ) {
153        %data = $cookies{$cookie_name}->value; # call ->value in list context
154    }
155    return ( username                   => $data{user}       || "Anonymous",
156             include_geocache_link      => $data{gclink}     || 0,
157             preview_above_edit_box     => $data{prevab}     || 0,
158             latlong_traditional        => $data{lltrad}     || 0,
159             omit_help_links            => $data{omithlplks} || 0,
160             show_minor_edits_in_rc     => $data{rcmined}    || 0,
161             default_edit_type          => $data{defedit}    || "normal",
162             cookie_expires             => $data{exp}        || "month",
163             track_recent_changes_views => $data{trackrc}    || 0,
164           );
165}
166
167
168=item B<make_recent_changes_cookie>
169
170  my $cookie = OpenGuides::CGI->make_recent_changes_cookie(
171      config => $config,
172  );
173
174Makes a cookie that stores the time now as the time of the latest
175visit to Recent Changes.  Or, if C<clear_cookie> is specified and
176true, makes a cookie with an expiration date in the past:
177
178  my $cookie = OpenGuides::CGI->make_recent_changes_cookie(
179      config       => $config,
180      clear_cookie => 1,
181  );
182
183=cut
184
185sub make_recent_changes_cookie {
186    my ($class, %args) = @_;
187    my $config = $args{config} or croak "No config object supplied";
188    croak "Config object not a Config::Tiny"
189        unless UNIVERSAL::isa( $config, "Config::Tiny" );
190    my $cookie_name = $class->_get_rc_cookie_name( config => $config );
191    # See explanation of expiry date hack above in make_prefs_cookie.
192    my $expires;
193    if ( $args{clear_cookie} ) {
194        $expires = "-1M";
195    } else {
196        $expires = "Thu, 31-Dec-2037 22:22:22 GMT";
197    }
198    my $cookie = CGI::Cookie->new(
199        -name  => $cookie_name,
200        -value => {
201                    time => time,
202                  },
203        -expires => $expires,
204    );
205    return $cookie;
206}
207
208
209=item B<get_last_recent_changes_visit_from_cookie>
210
211  my %prefs = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie(
212      config => $config
213  );
214
215Croaks unless a L<Config::Tiny> object is supplied as C<config>.
216Returns the time (as seconds since epoch) of the user's last visit to
217Recent Changes.
218
219=cut
220
221sub get_last_recent_changes_visit_from_cookie {
222    my ($class, %args) = @_;
223    my $config = $args{config} or croak "No config object supplied";
224    croak "Config object not a Config::Tiny"
225        unless UNIVERSAL::isa( $config, "Config::Tiny" );
226    my %cookies = CGI::Cookie->fetch;
227    my $cookie_name = $class->_get_rc_cookie_name( config => $config );
228    my %data;
229    if ( $cookies{$cookie_name} ) {
230        %data = $cookies{$cookie_name}->value; # call ->value in list context
231    }
232    return $data{time};
233}
234
235
236sub _get_cookie_name {
237    my ($class, %args) = @_;
238    my $site_name = $args{config}->{_}->{site_name}
239        or croak "No site name in config";
240    return $site_name . "_userprefs";
241}
242
243sub _get_rc_cookie_name {
244    my ($class, %args) = @_;
245    my $site_name = $args{config}->{_}->{site_name}
246        or croak "No site name in config";
247    return $site_name . "_last_rc_visit";
248}
249
250=back
251
252=head1 AUTHOR
253
254The OpenGuides Project (openguides-dev@openguides.org)
255
256=head1 COPYRIGHT
257
258     Copyright (C) 2003-2004 The OpenGuides Project.  All Rights Reserved.
259
260This module is free software; you can redistribute it and/or modify it
261under the same terms as Perl itself.
262
263=cut
264
2651;
266
Note: See TracBrowser for help on using the repository browser.