Release version 2.1 of the core library.
[itkacl] / itkacl-web-1.0 / include / itkaclcommon.pm
1 #! /usr/bin/perl
2 use strict;
3 use warnings;
4 use CGI;
5 use DBI;
6 use Apache::Session::Postgres;
7 use Encode;
8 use HTML::Entities;
9 use locale;
10 use utf8;
11
12 require 'config.pm';
13
14 package itkaclcommon;
15
16 our $cgi;
17 our $dbh;
18 our $last_modified = '$Date: 2011-11-19 11:08:01 $';
19 our %session;
20
21 sub init {
22         $cgi = new CGI;
23         $dbh = DBI->connect("dbi:Pg:dbname=$itkaclconfig::db_name;host=$itkaclconfig::db_host",
24                 $itkaclconfig::db_user, $itkaclconfig::db_pass)
25                 or die "Couldn't connect to database";
26         $dbh->{pg_enable_utf8} = 1;
27         $last_modified = '$Date: 2011-11-19 11:08:01 $';
28         %session = ();
29 }
30
31 sub print_header {
32         init();
33
34         # Find the cookie, if any
35         my $session_id = $cgi->cookie('itkaclsession');
36         tie %session, 'Apache::Session::Postgres', $session_id, {
37                 DataSource => "dbi:Pg:dbname=$itkaclconfig::sessiondb_name;host=$itkaclconfig::sessiondb_host",
38                 UserName   => $itkaclconfig::sessiondb_user,
39                 Password   => $itkaclconfig::sessiondb_pass,
40                 Commit     => 1
41         };
42
43         # Update with open/close
44         my $open = $cgi->param('open');
45         my $close = $cgi->param('close');
46         if (defined($open)) {
47                 $session{$open} = 1;
48         } elsif (defined($close)) {
49                 undef $session{$close};
50         }
51
52         my $cookie = $cgi->cookie(-name=>'itkaclsession',
53                         -value=>$session{_session_id},
54                         -expires=>'+1h');
55
56         binmode STDOUT, ":utf8";
57         print $cgi->header(-type=>'application/xhtml+xml; charset=utf-8', cookie=>$cookie, -expires=>'now');
58         
59         open HEADER, "<", $itkaclconfig::header
60                 or die "Couldn't open $itkaclconfig::header: $!";
61
62         # Find out if we're using SSO.
63         my $sso = "";
64         if (defined($ENV{'AUTH_TYPE'}) && $ENV{'AUTH_TYPE'} eq 'Negotiate') {
65                 $sso = '<img src="https://itk.samfundet.no/images/ssso-button.png" alt="Samfundet single sign-on" title="Samfundet single sign-on"/>';
66         }
67
68         # Set secure path.
69         local @ENV;
70         delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)};
71
72         my $quote;
73         if (defined($itkaclconfig::quotescript)) {
74                 # Hent inn quotes. Stygt, jodal! =)
75                 $quote = `$itkaclconfig::quotescript`;
76                 $quote = Encode::decode_utf8($quote);
77         }
78
79         while (<HEADER>) {
80                 s/\%QUOTES\%/$quote/ if defined($quote);
81                 s/\%SSO\%/$sso/;
82                 s/\%META\%//;
83                 s/\%TITLE\%/ITKACL-tre/;
84                 s/"http:\/\/([^"]*\.(css|png))"/"https:\/\/$1"/;
85                 print;
86         }
87
88         close HEADER;
89 }
90
91 sub print_footer {
92         untie %session;
93         
94         # Print footer
95         open FOOTER, "<", $itkaclconfig::footer
96                 or die "Couldn't open $itkaclconfig::footer: $!";
97
98         # Strip RCS stuff from $::last_modified
99         (my $lm = $last_modified) =~ s/^\$[D]ate: (.*) \$$/$1/;
100
101         while (<FOOTER>) {
102                 s/\%LAST_MODIFIED\%/$lm/;
103                 print;
104         }
105
106         close FOOTER;
107 }
108
109 sub print_tree {
110         my ($fulltree, $boldelem) = @_;
111         if ($fulltree) {
112                 print "    <div class=\"tree\">\n";
113         } else {
114                 print "    <div class=\"tree floatingtree\">\n";
115         }
116         
117         print "      <p><img src=\"/img/base-folder.png\" alt=\"\" width=\"21\" height=\"18\" />Samfundet</p>\n";
118
119         print_tree_element($dbh, undef, 0, [], $fulltree, $boldelem);
120
121         print "    </div>\n";
122 }
123
124 sub print_tree_element {
125         my ($dbh, $curr_obj, $level, $vbars, $fulltree, $boldelem) = @_;
126         
127         my $refs;
128         if (defined($curr_obj)) {
129                 $refs = $dbh->selectall_arrayref('SELECT id,name,description FROM objects WHERE parent=? ORDER BY name', undef, $curr_obj);
130         } else {
131                 $refs = $dbh->selectall_arrayref('SELECT id,name,description FROM objects WHERE parent IS NULL ORDER BY name');
132         }
133
134         my $i = 0;
135         my $count = (scalar @{$refs}) - 1;
136         for my $ref (@{$refs}) {
137                 # More siblings?
138                 my $msb;
139                 my @vbarscopy = @{$vbars};
140                 if ($i == $count) {
141                         $msb = "";
142                         push @vbarscopy, 0;
143                 } else {
144                         $msb = "-moresiblings";
145                         push @vbarscopy, 1;
146                 }
147
148                 print "    <p>";
149
150                 # Stuff to the left of folder
151                 for my $i (1..$level) {
152                         if ($vbars->[$i - 1]) {
153                                 print '<img src="/img/verticalbar.png" alt="|" width="16" height="18" />';
154                         } else {
155                                 print '<img src="/img/whitespace.png" alt="&nbsp;" width="16" height="18" />';
156                         }
157                 }
158
159                 # The folder itself
160                 my $countref = $dbh->selectrow_hashref('SELECT COUNT(*) AS num FROM objects WHERE parent=?', undef, $ref->[0]);
161                 if ($countref->{'num'} == 0) {
162                         if ($i == $count) {
163                                 print "<img src=\"/img/folder-nochildren.png\" alt=\"\" width=\"37\" height=\"18\" />";
164                         } else {
165                                 print "<img src=\"/img/folder-nochildren-moresiblings.png\" alt=\"|\" width=\"37\" height=\"18\" />";
166                         }
167                 } else {
168                         my $url = $cgi->url(-absolute=>1) . "?";
169                         my @params = ();
170                         for my $p ($cgi->param()) {
171                                 next if ($p eq 'open');
172                                 next if ($p eq 'close');
173                                 push @params, "$p=" . $cgi->param($p);
174                         }
175                         if (scalar @params > 0) {
176                                 $url .= join('&amp;', @params) . "&amp;";
177                         }
178                                                          
179                         if (defined($session{$ref->[0]})) {
180                                 print "<a href=\"${url}close=$ref->[0]\"><img src=\"/img/folder-open$msb.png\" alt=\"-\" width=\"37\" height=\"18\" /></a>";
181                         } else {
182                                 print "<a href=\"${url}open=$ref->[0]\"><img src=\"/img/folder-closed$msb.png\" alt=\"+\" width=\"37\" height=\"18\" /></a>";
183                         }
184                 }
185
186                 if (defined($boldelem) && $boldelem == $ref->[0]) {
187                         print "<strong>";
188                 }
189         
190                 my $e_entity = HTML::Entities::encode_entities($ref->[1]);
191                 my $e_description = HTML::Entities::encode_entities($ref->[2]);
192         
193                 if ($fulltree) {
194                         print "<a href=\"/view.pl?entry=$ref->[0]\">$e_entity: $e_description</a>";
195                 } else {
196                         print "<a href=\"/view.pl?entry=$ref->[0]\" title=\"$e_description\">$e_entity</a>";
197                 }
198                 
199                 if (defined($boldelem) && $boldelem == $ref->[0]) {
200                         print "</strong>";
201                 }
202                 print "</p>\n";
203                 
204                 if ($countref->{'num'} > 0 && defined($session{$ref->[0]})) {
205                         print_tree_element($dbh, $ref->[0], $level + 1, \@vbarscopy, $fulltree, $boldelem);
206                 }
207                 ++$i;
208         }
209 }
210
211 1;