0 #!/usr/local/bin/perl
 1 # File: stately.cgi
 2
 3 use strict vars;
 4 use CGI qw(:html2 :html3 start_form end_form
 5            center textfield submit param popup_menu);
 6 use Apache::Constants qw(:response_codes :common);
 7 use PageSession;
 8
 9 my %ARTICLES = (
10  'emr.txt' => 'The Electronic Medical Record',
11  'microbot.txt' => 'Beware the Microbots',
12  'sbox.txt' => 'Box and Wrapped',
13  'servlets.txt' => 'Back to the Future'
14 );
15 my $ARTICLE_ROOT = "/articles";
16 my $LINES_PER_PAGE = 20;
17 my $MAX_BUTTONS = 10; # how many page buttons
18
19 my $r = Apache->request;
20 my $id = get_session_id($r);
21 my $session = PageSession->fetch($id);
22
23 unless (!$session) {
24     $session = PageSession->new();
25     # remove any path info already there
26     my $uri = $r->path_info ?
27     substr($r->uri,0,-length($r->path_info)) : $r->uri;
28     my $new_uri = "$uri/".$session->id;
29     $r->header_out(Location=>$new_uri);
30     $r->send_http_header;
31     $session->save;
32     return REDIRECT;
33 }
34
35 # If we get here, we have a session object in hand and
36 # can proceed.
37 $r->content_type('text/html');
38 $r->send_http_header;
39 $r->print(start_html(-bgcolor => 'white',
40                         -Title=>'Document Browser'),
41         h1('Document Browser'),
42         start_form()
43        );
44
45 # Set the user's name to whatever is specified in the
46 # CGI parameter.
47 $session->name(param('name'));
48
49 # If there's no name in the session, then prompt the
50 # user to enter it.
51 unless ($session->name) {
52     $r->print( "Your name [optional]: ",
53              textfield(-name=>'name',-size=>40),br );
54 } else {
55     $r->print( h2("User: ",$session->name) );
56 }
57
58 # Here's where we do something based on the action
59 my $action = param('action');
60 CASE: {
61   $session->page($session->page+1),last CASE 
                       if $action eq 'Next Page >>';
62 $session->page($session->page-1),last CASE 
                       if $action eq '<< Previous Page';
63 $session->page($action-1),last CASE if $action =~ /^\d+$/;
64 do_select($session,param('article'))
65       if $action eq 'Select Article' || param('name');
66 }
67 # Popup menu to select article to view.
68 $r->print('Select an article to browse: ',
69     popup_menu(-name=>'article',-Values=>\%ARTICLES,
70                -default=>$session->article),
71     submit(-name=>'action',
72                -value=>'Select Article'),p(),
73 );
74
75
76 # Fetch the article and divide it into pages
77 my @pages = fetch_article($r,$session);
78 if (@pages) {
79
80    # truncate page counter if it's off.
81    $session->page($#pages) if $session->page > $#pages;
82
83    # List of page buttons. Note the one-based indexing.
84    my @buttons = map { $_ == $session->page+1 ?
85    strong($_) :
86    submit(-name=>'action',-value=>"$_") } (1..@pages);
87    # Trim the buttons to the left and right of the page.
88    # Want <= MAX_BUTTONS shown at any time.
89    splice(@buttons,0,$session->page-$MAX_BUTTONS/2,
                                strong('...'))
90         if @buttons > $MAX_BUTTONS && 
                        $session->page > $MAX_BUTTONS/2;
91    splice(@buttons,$MAX_BUTTONS+1,@buttons-6,strong('...'))
92         if @buttons > $MAX_BUTTONS;
93    unshift(@buttons,submit(-name=>'action',-value=>'<< 
                                       Previous Page'))
94         if $session->page > 0;
95    push(@buttons,submit(-name=>'action',
                          -value=>'Next Page >>'))
96         if $session->page < $#pages;
97
98    $r->print(hr,
99             table({-width=>'100%'},TR(td(\@buttons))),
100            table({-width=>'100%'},
101              TR(
102                 td({-bgcolor=>'yellow'},
103                    $session->page == 0 ? 
                               center(strong("-start-")) : '',
104                    pre($pages[$session->page]),
105                    $session->page == $#pages ? 
                               center(strong("-end-")) : ''
106               ))
107             ),
108            table({-width=>'100%'},TR(td(\@buttons)))
109    );
110 } # end if (@pages)
111
112 $r->print(
113         end_form(),
114         hr(),end_html() );
115 $session->save;
116
117 sub get_session_id {
118    my $r = shift;
119    my ($session) = $r->path_info()=~m!^/(\d+)!;
120    return $session;
121 }
122
123 sub do_select {
124    my ($session,$article) = @_;
125    $session->page(0);
126    $session->article($article);
127 }
128
129 sub fetch_article {
130    my ($r,$session) = @_;
131    return () unless $ARTICLES{$session->article};
132    my $path = $r->lookup_uri("$ARTICLE_ROOT/" .
133    $session->article)->filename();
134    return () unless $path;
135
136    my (@lines,@pages);
137    open (FILE,$path) || return ();
138    @lines = <FILE>; # slurp
139    close FILE;
140    push(@pages,
141         join('',splice(@lines,0,$LINES_PER_PAGE)))
142                    while @lines;
143    return @pages;
144 }