File Coverage

lib/MySQL/Admin.pm
Criterion Covered Total %
statement 54 142 38.0
branch 3 76 3.9
condition 4 21 19.0
subroutine 15 24 62.5
pod 11 11 100.0
total 87 274 31.7


line stmt bran cond sub pod time code
1             package MySQL::Admin;
2 2     2   5 use strict;
  2         3  
  2         42  
3 2     2   6 use warnings;
  2         2  
  2         41  
4 2     2   6 no warnings 'redefine';
  2         4  
  2         85  
5 2     2   12 use utf8;
  2         3  
  2         7  
6 2     2   524 use MySQL::Admin::Settings;
  2         4  
  2         163  
7 2     2   561 use MySQL::Admin::Translate;
  2         3  
  2         149  
8 2     2   8 use MySQL::Admin::Config;
  2         1  
  2         117  
9 2     2   522 use MySQL::Admin::Session;
  2         3  
  2         148  
10 2     2   510 use MySQL::Admin::Actions;
  2         4  
  2         212  
11             use CGI
12 2         24 qw(-compile -utf8 :html2 :html3 :netscape :cgi :internal :html4 :cgi-lib textfield textarea filefield password_field hidden checkbox checkbox_group submit reset defaults radio_group popup_menu button autoEscape
13 2     2   1591 scrolling_list image_button start_form end_form start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART -private_tempfiles );
  2         50845  
14              
15             require Exporter;
16 2         2756 use vars qw(
17             $m_hrParams
18             $m_qy
19             $m_hrActions
20             $ACCEPT_LANGUAGE
21             $DefaultClass
22             $m_nUplod_bytes
23             $DefaultClass
24             @EXPORT
25             @ISA
26             $m_bMod_perl
27             $m_hrSettings
28             $m_sUser
29             $m_hrLng
30             @EXPORT_OK
31             %EXPORT_TAGS
32             $defaultconfig
33             $m_bUpload_error
34             $m_nUplod_bytes
35 2     2   5884 );
  2         4  
36              
37             $CGI::DefaultClass = 'CGI';
38             $DefaultClass = 'MySQL::Admin' unless defined $MySQL::Admin::DefaultClass;
39             $defaultconfig = '%CONFIG%';
40             $CGI::AutoloadClass = 'CGI';
41             $MySQL::Admin::VERSION = '1.11';
42             $m_bMod_perl = ($ENV{MOD_PERL}) ? 1 : 0;
43             our $hold = 120; #session ist 120 sekunden gültig.
44             @ISA = qw(Exporter CGI);
45             @MySQL::Admin::EXPORT_OK =
46             qw(hook start_table end_table include h1 h2 h3 h4 h5 h6 p br hr ol ul li dl dt dd menu code var strong em tt u i b blockquote pre img a address cite samp dfn html head base body Link nextid title meta kbd start_html end_html input Select option comment charset escapeHTML div table caption th td TR Tr sup Sub strike applet Param embed basefont style span layer ilayer font frameset frame script small big Area Map abbr acronym bdo col colgroup del fieldset iframe ins label legend noframes noscript object optgroup Q thead tbody tfoot blink fontsize center textfield textarea filefield password_field hidden checkbox checkbox_group submit reset defaults radio_group popup_menu button autoEscape scrolling_list image_button start_form end_form start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART param upload path_info path_translated request_uri url self_url script_name cookie Dump raw_cookie request_method query_string Accept user_agent remote_host content_type remote_addr referer server_name server_software server_port server_protocol virtual_port virtual_host remote_ident auth_type http append save_parameters restore_parameters param_fetch remote_user user_name header redirect import_names put Delete Delete_all url_param cgi_error ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars https $ACCEPT_LANGUAGE translate init session createSession $m_hrParams clearSession $m_qy sessionValidity includeAction);
47             $ACCEPT_LANGUAGE ='de';
48             %EXPORT_TAGS = (
49             'html2' => [
50             'h1' .. 'h6', qw/p br hr ol ul li dl dt dd menu code var strong em
51             tt u i b blockquote pre img a address cite samp dfn html head
52             base body Link nextid title meta kbd start_html end_html
53             input Select option comment charset escapeHTML/
54             ],
55             'html3' => [
56             qw/div table caption th td TR Tr sup Sub strike applet Param
57             embed basefont style span layer ilayer font frameset frame script small big Area Map/
58             ],
59             'html4' => [
60             qw/abbr acronym bdo col colgroup del fieldset iframe
61             ins label legend noframes noscript object optgroup Q
62             thead tbody tfoot/
63             ],
64             'netscape' => [qw/blink fontsize center/],
65             'form' => [
66             qw/textfield textarea filefield password_field hidden checkbox checkbox_group
67             submit reset defaults radio_group popup_menu button autoEscape
68             scrolling_list image_button end_form start_form
69             start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/
70             ],
71             'cgi' => [
72             qw/param upload path_info path_translated request_uri url self_url script_name
73             cookie Dump
74             raw_cookie request_method query_string Accept user_agent remote_host content_type
75             remote_addr referer server_name server_software server_port server_protocol virtual_port
76             virtual_host remote_ident auth_type http append
77             save_parameters restore_parameters param_fetch
78             remote_user user_name header redirect import_names put
79             Delete Delete_all url_param cgi_error/
80             ],
81             'ssl' => [qw/https/],
82             'cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars/],
83             'html' => [
84             qw/h1 h2 h3 h4 h5 h6 p br hr ol ul li dl dt dd menu code var strong em tt u i b blockquote pre img a address cite samp dfn html head base body Link nextid title meta kbd start_html end_html input Select option comment charset escapeHTML div table caption th td TR Tr sup Sub strike applet Param embed basefont style span layer ilayer font frameset frame script small big Area Map abbr acronym bdo col colgroup del fieldset iframe ins label legend noframes noscript object optgroup Q thead tbody tfoot blink fontsize center/
85             ],
86             'standard' => [
87             qw/h1 h2 h3 h4 h5 h6 p br hr ol ul li dl dt dd menu code var strong em tt u i b blockquote pre img a address cite samp dfn html head base body Link nextid title meta kbd start_html end_html input Select option comment charset escapeHTML div table caption th td TR Tr sup Sub strike applet Param embed basefont style span layer ilayer font frameset frame script small big Area Map abbr acronym bdo col colgroup del fieldset iframe ins label legend noframes noscript object optgroup Q thead tbody tfoot textfield textarea filefield password_field hidden checkbox checkbox_group
88             submit reset defaults radio_group popup_menu button autoEscape
89             scrolling_list image_button start_form end_form
90             start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART param upload path_info path_translated request_uri url self_url script_name
91             cookie Dump
92             raw_cookie request_method query_string Accept user_agent remote_host content_type
93             remote_addr referer server_name server_software server_port server_protocol virtual_port
94             virtual_host remote_ident auth_type http append
95             save_parameters restore_parameters param_fetch
96             remote_user user_name header redirect import_names put
97             Delete Delete_all url_param cgi_error/
98             ],
99             'push' => [qw/multipart_init multipart_start multipart_end multipart_final/],
100             'all' => [
101             qw/h1 h2 h3 h4 h5 h6 p br hr ol ul li dl dt dd menu code var strong em tt u i b blockquote pre img a address cite samp dfn html head base body Link nextid title meta kbd start_html end_html input Select option comment charset escapeHTML div table caption th td TR Tr sup Sub strike applet Param embed basefont style span layer ilayer font frameset frame script small big Area Map abbr acronym bdo col colgroup del fieldset iframe ins label legend noframes noscript object optgroup Q thead tbody tfoot blink fontsize center textfield textarea filefield password_field hidden checkbox checkbox_group submit reset defaults radio_group popup_menu button autoEscape scrolling_list image_button start_form end_form start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART param upload path_info path_translated request_uri url self_url script_name cookie Dump raw_cookie request_method query_string Accept user_agent remote_host content_type remote_addr referer server_name server_software server_port server_protocol virtual_port virtual_host remote_ident auth_type http append save_parameters restore_parameters param_fetch remote_user user_name header redirect import_names put Delete Delete_all url_param cgi_error ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars $ACCEPT_LANGUAGE translate init session createSession $m_hrParams clearSession $m_qy sessionValidity includeAction include/
102             ],
103             );
104              
105             =head1 NAME
106              
107             MySQL::Admin - Just a MySQL administration Web-App
108              
109             =head1 SYNOPSIS
110              
111             use MySQL::Admin;
112              
113             =head1 DESCRIPTION
114              
115             MySQL::Admin is a Database Web-frontend and CMS.
116              
117             This Module is an CGI subclass, mainly written for L.
118              
119             =head2 EXPORT
120              
121             export_ok:
122              
123             $ACCEPT_LANGUAGE translate init session createSession $m_hrParams clearSession $m_qy include sessionValidity includeAction
124              
125              
126             export tags:
127             myqsl: $ACCEPT_LANGUAGE translate init session createSession $m_hrParams clearSession $m_qy include sessionValidity includeAction
128              
129             and all export tags from L
130              
131             =head1 Public
132              
133             =head2 new()
134              
135             =cut
136              
137             sub new {
138 2     2 1 7 my ($class, @initializer) = @_;
139 2         2 my $self = {};
140 2   33     15 bless $self, ref $class || $class || $DefaultClass;
141 2         7 return $self;
142             }
143              
144             =head2 init()
145              
146             init("/srv/www/cgi-bin/config/settings.pl");
147              
148             default: /srv/www/cgi-bin
149              
150             =cut
151              
152             sub init {
153 2     2 1 10 my ($self, @p) = getSelf(@_);
154 2 50       6 my $settingfile = $p[0] ? $p[0] : $defaultconfig;
155 2         16 loadSettings($settingfile);
156 2         8 *m_hrSettings = \$MySQL::Admin::Settings::m_hrSettings;
157 2         19 loadTranslate($m_hrSettings->{translate});
158 2         9 *m_hrLng = \$MySQL::Admin::Translate::lang;
159 2         15 loadSession($m_hrSettings->{session});
160 2         6 *m_qy = \$MySQL::Admin::Session::session;
161 2         15 loadActions($m_hrSettings->{actions});
162 2         5 *m_hrAction = \$MySQL::Admin::Actions::m_hrAction;
163 2         5 $m_nUplod_bytes = 0;
164 2         30 $m_bUpload_error = 0;
165             }
166              
167             =head2 include
168              
169             %vars = (sub => 'main','file' => "fo.pl");
170              
171             $qstring = createSession(\%vars);
172              
173             include($qstring); #InVoid context param('include') will be used.
174              
175             =cut
176              
177             sub include {
178 0     0 1 0 my ($self, @p) = getSelf(@_);
179 0 0       0 my $qstring = $p[0] ? $p[0] : param('include') ? param('include') : 0;
    0          
180 0 0       0 if (defined $qstring) {
181 0         0 session($qstring);
182 0 0 0     0 if (defined $m_hrParams->{file} && defined $m_hrParams->{sub}) {
183 0 0       0 if (-e $m_hrParams->{file}) {
184 0         0 do("$m_hrParams->{file}");
185 0 0       0 eval($m_hrParams->{sub}) if $m_hrParams->{sub} ne 'main';
186 0 0       0 warn $@ if ($@);
187             } else {
188 0         0 do("$m_hrActions->{$m_hrSettings->{defaultAction}}{file}");
189             eval($m_hrActions->{$m_hrSettings->{defaultAction}}{sub})
190 0 0       0 if $m_hrActions->{$m_hrSettings->{defaultAction}}{sub} ne 'main';
191 0 0       0 warn $@ if ($@);
192             }
193             }
194             }
195             }
196              
197             =head2 includeAction
198              
199             includeAction('welcome');
200              
201             see L
202              
203             =cut
204              
205             sub includeAction {
206 0     0 1 0 my ($self, @p) = getSelf(@_);
207 0 0       0 my $m_hrAction = param('action') ? param('action') : $p[0] ? $p[0] : 0;
    0          
208 0 0       0 if (defined $m_hrActions->{$m_hrAction}) {
209 0 0 0     0 if (defined $m_hrActions->{$m_hrAction}{file} && defined $m_hrActions->{$m_hrAction}{sub}) {
210 0 0       0 if (-e $m_hrParams->{file}) {
211 0         0 do("$m_hrSettings->{cgi}{bin}/Content/$m_hrActions->{$m_hrAction}{file}");
212             eval($m_hrActions->{$m_hrAction}{sub})
213 0 0       0 if $m_hrActions->{$m_hrAction}{sub} ne 'main';
214 0 0       0 warn $@ if ($@);
215             } else {
216 0         0 do( "$m_hrSettings->{cgi}{bin}/Content/$m_hrActions->{$m_hrSettings->{defaultAction}}{file}"
217             );
218             eval($m_hrActions->{$m_hrSettings->{defaultAction}}{sub})
219 0 0       0 if $m_hrActions->{$m_hrSettings->{defaultAction}}{sub} ne 'main';
220 0 0       0 warn $@ if ($@);
221             }
222             }
223             }
224             }
225              
226             =head2 createSession
227              
228             Secure your Session (or simple store session informations);
229              
230             my %vars = (first => 'query', secondly => "Jo" , validity => time() );
231              
232             my $qstring = createSession(\%vars);
233              
234             *params= \$MySQL::Admin::params;
235              
236             session( $qstring );
237              
238             print $m_hrParams->{first};
239              
240             =cut
241              
242             sub createSession {
243 0     0 1 0 my ($self, @p) = getSelf(@_);
244 0         0 my $par = shift @p;
245 0 0       0 $m_sUser = $par->{user} ? $par->{user} : 'guest';
246 0         0 my $ip = $self->remote_addr();
247 0         0 my $time = time();
248 0 0       0 my $id = $par->{action} ? $par->{action} : rand 100;
249 2     2   1404 use MD5;
  2         314  
  2         1826  
250 0         0 my $md5 = new MD5;
251 0         0 $md5->add($m_sUser);
252 0         0 $md5->add($time);
253 0         0 $md5->add($ip);
254 0         0 $md5->add($id);
255 0         0 my $fingerprint = $md5->hexdigest();
256              
257 0         0 foreach my $key (sort(keys %{$par})) {
  0         0  
258 0         0 $m_qy->{$m_sUser}{$fingerprint}{$key} = $par->{$key};
259 0         0 $m_hrParams->{$key} = $par->{$key};
260             }
261             $m_qy->{$m_sUser}{$fingerprint}{timestamp} =
262 0 0       0 defined $par->{validity} ? $par->{validity} : time();
263 0         0 saveSession($m_hrSettings->{session});
264 0         0 return $fingerprint;
265             }
266              
267             =head2 session
268              
269             $qstring = session(\%vars);
270              
271             session($qstring);
272              
273             print $m_hrParams->{'key'};
274              
275             =cut
276              
277             #################################### session###################################################################
278             # Diese Funktion lädt die Parameter die mit createSession erzeugt wurden. #
279             # Als parameter erwartet Sie den wert den createSession zurückgegeben hat: #
280             # Im Void Kontext wird param('include') benutzt. #
281             ###############################################################################################################
282              
283             sub session {
284 0     0 1 0 my ($self, @p) = getSelf(@_);
285 0 0       0 if (ref($p[0]) eq 'HASH') {
286 0         0 $self->createSession(@p);
287             } else {
288 0 0       0 my $param = param('include') ? param('include') : shift @p;
289 0 0       0 $m_sUser = $p[0] ? $p[0] : 'guest';
290 0         0 foreach my $key (sort(keys %{$m_qy->{$m_sUser}{$param}})) {
  0         0  
291 0         0 $m_hrParams->{$key} = $m_qy->{$m_sUser}{$param}{$key};
292             }
293 0         0 $m_hrParams->{session_id} = $param;
294             # delete $m_qy->{$m_sUser}{$param};
295             }
296 0         0 saveSession($m_hrSettings->{session});
297             }
298              
299             =head2 clearSession
300              
301             delete old sessions. Delete all session older then 120 sec.
302              
303             =cut
304              
305             sub clearSession {
306 0     0 1 0 foreach my $ua (keys %{$m_qy}) {
  0         0  
307 0         0 foreach my $entry (keys %{$m_qy->{$ua}}) {
  0         0  
308             my $t =
309 0 0       0 $m_qy->{$ua}{$entry}{timestamp} ? time() - $m_qy->{$ua}{$entry}{timestamp} : time();
310             $hold =
311             defined $m_qy->{$ua}{$entry}{validity}
312             ? defined $m_qy->{$ua}{$entry}{validity}
313 0 0       0 : $hold;
314 0 0       0 delete $m_qy->{$ua}{$entry} if ($t > $hold);
315             }
316             }
317 0         0 saveSession($m_hrSettings->{session});
318             }
319              
320             =head2 sessionValidity()
321              
322             set the session Validity in seconds in scalar context:
323              
324             sessionValidity(120); #120is the dafault value
325              
326             or get it in void context:
327              
328             $time = sessionValidity();
329              
330             =cut
331              
332             sub sessionValidity {
333 0     0 1 0 my ($self, @p) = getSelf(@_);
334 0 0 0     0 if (defined $p[0] and $p[0] =~ /(\d+)/) {
335 0         0 $hold = $1;
336             } else {
337 0         0 return $hold;
338             }
339             }
340              
341             =head2 translate()
342              
343             translate(key);
344              
345             see L
346              
347             =cut
348              
349             sub translate {
350 0     0 1 0 my ($self, @p) = getSelf(@_);
351 0         0 my $key = lc $p[0];
352             my @a = split(
353             /,/, defined $ENV{HTTP_ACCEPT_LANGUAGE}
354             ? $ENV{HTTP_ACCEPT_LANGUAGE}
355 0 0       0 : 'de,en'
356             );
357              
358 0         0 my $i = 0;
359 0         0 while ($i <= $#a) {
360 0 0       0 my $lng = $a[$i] =~ s/(\w\w).*/$1/ ? $1 : $m_hrSettings->{language};
361 0 0       0 if (defined $m_hrLng->{$lng}{$key}) {
362 0         0 $ACCEPT_LANGUAGE = $lng;
363 0         0 return $m_hrLng->{$lng}{$key};
364             }
365 0         0 $i++;
366             }
367 0 0       0 $m_hrLng->{en}{$key} = $key unless defined $m_hrLng->{en}{$key};
368 0 0       0 $m_hrLng->{de}{$key} = $key unless defined $m_hrLng->{de}{$key};
369              
370             #$m_hrLng->{es}{$key} = $key unless defined $m_hrLng->{es}{$key};
371 0 0       0 saveTranslate($m_hrSettings->{translate}) if $m_hrSettings->{saveTranslate};
372 0         0 return $p[0];
373             }
374              
375             =head2 param
376              
377             param don't work in oo syntax
378              
379             =cut
380              
381             sub param{
382 0     0   0 my ($self, @p) = getSelf(@_);
383 0         0 return CGI::param(@p);
384             }
385              
386             =head2 hook
387              
388             used by include and includeAction.
389              
390             =cut
391              
392             sub hook {
393 0     0 1 0 my ($self, @p) = getSelf(@_);
394 0         0 my ($m_sFilename, $buffer, $bytes_read, $data) = @p;
395 0         0 warn 'To big upload :', $m_sFilename, $buffer, $bytes_read, $data, $/;
396 0 0       0 if ($m_nUplod_bytes <= $m_hrSettings->{uploads}{maxlength}) {
397 0         0 require bytes;
398 0         0 $m_nUplod_bytes += bytes::length($buffer);
399             } else {
400 0         0 $m_bUpload_error = 1;
401 0         0 warn 'To big upload :', $m_sFilename, $/;
402             }
403             }
404              
405             =head1 Private
406              
407              
408             =head2 getSelf()
409              
410             =cut
411              
412             sub getSelf {
413 2 50 33 2 1 18 return @_ if defined($_[0]) && (!ref($_[0])) && ($_[0] eq 'MySQL::Admin');
      33        
414 2 50 33     43 return (defined($_[0])
415             && (ref($_[0]) eq 'MySQL::Admin' || UNIVERSAL::isa($_[0], 'MySQL::Admin')))
416             ? @_
417             : ($MySQL::Admin::DefaultClass->new, @_);
418             }
419              
420             =head1 AUTHOR
421              
422             Dirk Lindner
423              
424             =head1 LICENSE
425              
426             Copyright (C) 2005-2016 by Hr. Dirk Lindner
427              
428             This program is free software; you can redistribute it and/or
429             modify it under the terms of the GNU Lesser General Public License
430             as published by the Free Software Foundation;
431             This program is distributed in the hope that it will be useful,
432             but WITHOUT ANY WARRANTY; without even the implied warranty of
433             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
434             GNU Lesser General Public License for more details.
435              
436             =cut
437              
438             =head2 see Also
439              
440             L L L L L L
441              
442             =head1 AUTHOR
443              
444             Dirk Lindner
445              
446              
447             =cut
448              
449             1;