Thread Textdatenbank - Erweiterung des Codes .. (16 answers)
Opened by Yagyu at 2011-02-10 04:56

Yagyu
 2011-02-10 04:57
#145535 #145535
User since
2010-12-18
15 Artikel
BenutzerIn
[default_avatar]
Hier mal die Quelldatein von Topeg, bevor ich daran Versuche gemacht habe.
(als 2. post, da beide posts zusammen, zulang waren -.-)

Edit: Hoffe bin damit im richtigen Forum, da es ja sowohl das CGI betrifft, als auch Datenbanken ...

mydb.pm
more (33.5kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

package mydb;
use strict;
use warnings;
use Digest::MD5 qw(md5_hex);
use utf8;

sub new
{
  my $class=shift;
  my $file=shift;
  return undef unless($file);
  my $self={};
  $self->{file}  =$file;
  $self->{table} ={};
  $self->{update}=0;
  $self->{last}  =0;
  bless($self,ref($class)||$class);
  $self->load;
  return $self;
}

sub DESTROY{ shift->save(); }

sub load
{
  my $self=shift;
  $self->{update}=1;
  return 0 unless(-f $self->{file});
  if(open(my $fh, '<', $self->{file}))
  {
    while(<$fh>)
    {
      chomp;
      my ($name,$pass)=map{__unquote($_)}split(/#/,$_,2);
      next unless($name && $pass);
      $self->{table}->{$name}=$pass;
    }
    close($fh);
    $self->{update}=0;
    $self->{last}=-M $self->{file};
  }
}

sub save
{
  my $self=shift;
  if($self->{update} && %{$self->{table}})
  {
    my $str=join("\n",map{__quote($_).'#'.__quote($self->{table}->{$_})}keys(%{$self->{table}}));
    $self->_update();
    if(open(my $fh, '>', $self->{file}))
    {
      print $fh $str;
      close($fh);
      $self->{update}=0;
      return 1;
    }
    return 0
  }
  return 1;
}

sub add
{
  my $self=shift;
  my $name=shift;
  my $pass=shift;
  $self->_update();
  return 0 unless($name && $pass);
  return 0 if(exists($self->{table}->{$name}));
  $self->{table}->{$name}=md5_hex($pass);
  $self->{update}=1;
  return 1;
}

sub del
{
  my $self=shift;
  my $name=shift;
  $self->_update();
  return 0 unless($name && exists($self->{table}->{$name}));
  delete($self->{table}->{$name});
  $self->{update}=1;
  return 1;
}

sub has{ return exists($_[0]->{table}->{$_[1]}); }

sub set
{
  my $self=shift;
  my $name=shift;
  my $pass=shift;
  $self->_update();
  return 0 unless($name && $pass);
  return 0 unless(exists($self->{table}->{$name}));
  $self->{table}->{$name}=md5_hex($pass);
  $self->{update}=1;
  return 1;
}

sub chk
{
  my $self=shift;
  my $name=shift;
  my $pass=shift;
  $self->_update();
  return 0 unless($name && $pass && exists($self->{table}->{$name}) && $self->{table}->{$name} eq md5_hex($pass));
  return 1;
}

sub get
{
  my $self=shift;
  my $name=shift;
  $self->_update();
  return $self->{table}->{name} if($name && exists($self->{table}->{name}));
  return '';
}

########################################################################
sub _update
{
  my $self=shift;
  return $self->load() if(-f $self->{file} && (!$self->{last} || -M $self->{file} != $self->{last}));
  return 1;
}

########################################################################
sub __quote
{
  my $str=shift;
  $str=~s/#/&raute;/g;
  return $str;
}

sub __unquote
{
  my $str=shift;
  $str=~s/\Q&raute;/#/g;
  return $str;
}

1;


registration.pl
more (31.5kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

#!/usr/bin/perl
use strict;
use warnings;
use mydb;
use CGI;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use utf8;

my $db=mydb->new('test.db');
my $form = CGI->new();
my $session = CGI::Session->new("driver:File", $form, { Directory=>"/tmp" }) or die CGI::Session->errstr;

my $sname=$ENV{SCRIPT_NAME}||'registration.pl';

print $session->header();
warningsToBrowser(1);

my $aktion=$form->param('aktion') || 'init';
$form->delete('aktion');

if($aktion eq 'add')
{
  my $name=$session->param('name');
  my $pass=$session->param('pass');
  if($name && $pass && $db->add($name,$pass))
  {
    $db->save();
    print_add($sname,$form);
  }
  else
  { print_input($sname,$form,"Name / Passort sind nicht gesetzt!") }
}
elsif($aktion eq 'check')
{
  my $name=$form->param('name');
  my $pass=$form->param('pass1');
  if($pass ne $form->param('pass2'))
  { print_input($sname,$form,'Die Passwörter stimmen nicht überein!'); }
  elsif($db->has($name))
  { print_input($sname,$form,'Der Name ist schon registrieret!'); }
  else
  {
    $session->param('name',$name);
    $session->param('pass',$pass);
    print_check($sname,$form,$name);
  }
}
elsif($aktion eq 'init')
{ print_input($sname,$form); }
else
{ print_input($sname,$form,'unerlaubte Aktion!'); }

########################################################################
sub print_add
{
  my $sname=shift;
  my $form=shift;
  my $name=shift;
  print
    $form->start_html("Registrierung abgeschlossen!"),
    $form->h1("Registrierung abgeschlossen!"),
    $form->p("Ihre Eingaben wurden akzeptiert. Sie können sich unter dem namen $name anmelden."),
    $form->end_html();
}

sub print_check
{
  my $sname=shift;
  my $form=shift;
  print
    $form->start_html("Ihre Eingaben"),
      $form->startform(-action => $sname, -method => 'POST' ),
        $form->hidden('aktion','add'),
        $form->h1("Ihre Eingaben"),
        $form->table({-border=>1},
          $form->Tr({-align=>'CENTER' ,-valign=>'TOP'}, [
            $form->td(["NAME:",     $form->param('name')]),
            $form->td(["PASSWORT:", $form->param('pass1')]),
          ]),
        ),
        $form->br(),
        $form->submit("Registrierung abschließen"),
      $form->endform(),
      $form->startform(-action => $sname, -method => 'POST'),
        $form->hidden('aktion','init'),
        $form->submit("Ändern"),
      $form->endform(),
    $form->end_html();
}

sub print_input
{
  my $sname=shift;
  my $form=shift;
  my $message=shift;
  print
    $form->start_html("Registration"),
      $form->h1("Registration | Ausleihe MMSZ.org"),
      $form->h4("Bitte geben Sie Ihre Daten ein"),
      $form->startform(-action => $sname, -method => 'POST' ),
        $form->hidden('aktion','check'),
        $form->table({-border=>0},
          $form->Tr({-align=>"LEFT", -valign=>"TOP"},[
            $form->td(['Name'                 , $form->textfield(     -name=>'name',  -size=>30, -maxlength=>30, -value=>$form->param('name')), "", ""]),
            $form->td(['Passwort'             , $form->password_field(-name=>'pass1', -size=>30, -maxlength=>30                              ), "", ""]),
            $form->td(['Passwort wiederholen' , $form->password_field(-name=>'pass2', -size=>30, -maxlength=>30                              ), "", ""]),
          ]),
        ),
        $form->br(),
        $form->submit("Registrieren"),
        " ",
        $form->reset("Löschen");

print   $form->br(),$form->p("NACHRICHT:$message") if($message);

print $form->endform(),
    $form->end_html();
}


login.pl:
more (19.0kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

#!/usr/bin/perl
use strict;
use warnings;
use mydb;
use CGI;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use utf8;

my $db=mydb->new('test.db');
my $form = CGI->new();
my $session = CGI::Session->new("driver:File", $form, { Directory=>"/tmp" }) or die CGI::Session->errstr;

my $sname=$ENV{SCRIPT_NAME}||'login.pl';

print $session->header();
warningsToBrowser(1);

my $login=$session->param("loggedin");

my $name=$form->param('name');
my $pass=$form->param('pass');

if($form->param('logout'))
{
  $session->delete('loggedin','name','pass');
  print_login($sname,$form); # <== print_ vergessen...
}
elsif($login)
{
  my $name=$session->param('name');
  login_ok($sname,$form,$name);
}
elsif($db->chk($name, $pass))
{
  $session->param("loggedin",1);
  $session->param('name',$name);
  print_ok($sname,$form,$name);
}
else
{ print_login($sname,$form); }

########################################################################

sub print_login
{
  my $sname=shift;
  my $form=shift;
  print
    $form->start_html("LOGIN"),
      $form->h1("Login | Ausleihe MMSZ.org"),
      $form->h4("LOGIN"),
      $form->startform(-action => $sname, -method => 'POST' ),
        $form->table({-border=>0},
          $form->Tr({-align=>"LEFT", -valign=>"TOP"},[
            $form->td(['Name'                 , $form->textfield(     -name=>'name',  -size=>30, -maxlength=>30, -value=>$form->param('name'))]),
            $form->td(['Passwort'             , $form->password_field(-name=>'pass', -size=>30, -maxlength=>30                               )]),
          ]),
        ),
        $form->br(),
        $form->submit("Login"),
        " ",
        $form->reset("Löschen"),
      $form->endform(),
    $form->end_html();
}

sub print_ok
{
  my $sname=shift;
  my $form=shift;
  my $name=shift;
  print
    $form->start_html("LOGIN OK!"),
    $form->h1("Login erfolgreich!"),
    $form->p("Willkommen $name"),
    $form->h4(
      $form->a({href=>"$sname?logout=1"},"LOGOUT"),
    ),
    $form->end_html();
}


test.pl
more (12.3kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

#!/usr/bin/perl
use strict;
use warnings;
use mydb;
use CGI;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use utf8;

my $db=mydb->new('test.db');
my $form = CGI->new();
my $session = CGI::Session->new("driver:File", $form, { Directory=>"/tmp" }) or die CGI::Session->errstr;

my $sname=$ENV{SCRIPT_NAME}||'test.pl';

print $session->header();
warningsToBrowser(1);

my $user=$session->param('name');
my $login=$session->param("loggedin");

if($login)
{
  print_ok($sname,$form,$user);
}
else
{
  print_login($sname,$form);
}

########################################################################

sub print_ok
{
  my $sname=shift;
  my $form=shift;
  my $suser=shift;
  print
    $form->start_html("Viele tolle sachen!"),
    $form->h1("Hallo $user!"),
    $form->p("Es ist schön sie zu sehen!"),
    $form->h4(
      $form->a({href=>"login.pl?logout=1"},"LOGOUT"),
    ),
    $form->end_html();
}

sub print_login
{
  my $sname=shift;
  my $form=shift;
  print
    $form->start_html("Bitte Einloggen!"),
    $form->h1("Diese seite ist Passortgeschützt!!"),
    $form->p("Bitte Loggen sie sich ein!"),
    $form->h4(
      $form->a({href=>"login.pl"},"LOGIN"),
    ),
    $form->br(),
    $form->h4(
      $form->a({href=>"registration.pl"},"Registrieren"),
    ),
    $form->end_html();
}


Danke an alle die bis hierher gelesen haben und sich evtl noch ein wenig mehr Zeit für mich nehmen, lernwillig bin ich aufjedenfall :)
Last edited: 2011-02-10 04:58:51 +0100 (CET)

View full thread Textdatenbank - Erweiterung des Codes ..