Thread Mysql und Perl (33 answers)
Opened by Johannes at 2012-06-14 09:14

topeg
 2012-06-14 17:03
#159037 #159037
User since
2006-07-10
2611 articles
BenutzerIn

user image
So nun habe ich den Code mal richtig aufgeräumt:

more (31.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
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
package                         database                                                        ;
use                             strict                                                          ;
use                             warnings                                                        ;
use                             DBI                                                             ;

        our                     $con                                                            =
                                "DBI:mysql:test_db"                                             ;
        our                     $user                                                           =
                                "root"                                                          ;
        our                     $passwort                                                       =
                                "pwd"                                                           ;
        my                      $db                                                             ;
                
sub             open_db                                                                         {
                                $db                                                             =
                DBI                                                                             ->
                connect                                                                         (
                                $con                                                            ,
                                $user                                                           ,
                                $passwort
                                                                                                )
                or
                die             "DB connection not made: $DBI::errstr"
                unless          $db                                                             ;
                return          $db                                                             ;
                                                                                                }
sub             close_db                                                                        {
                return
                unless          $db                                                             ;
                                $db                                                             ->
                disconnect                                                                      ;
                undef           $db                                                             ;
                                                                                                }
sub             insert_tab                                                                      {
        my                      $table                                                          =
                shift                                                                           ;
        my                      $values                                                         =
                shift                                                                           ;
        my                      $primary_key                                                    =
                shift                                                                           ;

                return          0                               
                unless          $table                                                          &&
                                $values                                                         ;
                return          0
                if
                ref             $values                                                         ne
                                'HASH'                                                          ;
        my                      @vals                                                           ;
        my                      @keys                                                           ;
                while                                                                           (
        my                                                                                      (
                                $k                                                              ,
                                $v                                                              )
                                                                                                =
                each            %$values                                                        )
                                                                                                {
                push            @vals                                                           ,
                                $v                                                              ;
                push            @keys                                                           ,
                                $k                                                              ;
                                                                                                }
        my                      $insert_keys                                                    =
                join            ', '                                                            ,
                                @keys                                                           ;
        my                      $insert_vals                                                    =
                join            ', '                                                            ,
                                '?'                                                             x
                                @keys;
        my                      $dbh                                                            =
                open_db                                                                         ;
        my                      $sth                                                            =
                                $dbh                                                            ->
                prepare                                                                         (       
                                "INSERT INTO $table ( $insert_keys ) VALUES ( $insert_vals )"
                                                                                                )
                                                                                                ;
        my                      $ok                                                             =
                                $sth                                                            ->
                execute                                                                         (
                                @$values                                                        )
                                                                                                ;
                                $sth                                                            ->
                finish                                                                          ;

                return          1
                if              $ok                                                             ;
                return          0
                unless  
                defined         $primary_key                                                    ;
                return          0
                unless
                exists          $values                                                         ->
                                                                                                {
                                $primary_key                                                    }
                                                                                                ;

        my                      $primary_val                                                    =
                delete          $values                                                         ->
                                                                                                {
                                $primary_key                                                    }
                                                                                                ;
                                $#vals                                                          =
                                0                                                               ;
                                $#keys                                                          =
                                0                                                               ;
                while                                                                           (
        my                                                                                      (
                                $k                                                              ,
                                $v                                                              )
                                                                                                =
                each            %$values                                                        )
                                                                                                {
                push            @vals                                                           ,
                                $v;
                push            @keys                                                           ,
                                $k;                     
                                                                                                }
        my                      $update_vals                                                    =
                join            ', '                                                            ,
                map             "$_ = ?"                                                        ,
                                @keys                                                           ;

                                $sth                                                            =
                                $dbh                                                            ->
                prepare                                                                         (
                                "UPDATE $table SET $update_vals WHERE $primary_key = ?"
                                                                                                )
                                                                                                ;
                                $ok                                                             =
                                $sth                                                            ->
                execute                                                                         (
                                @vals                                                           ,
                                $primary_val                                                    )
                                                                                                ;
                                $sth                                                            ->
                finish                                                                          ;
                return          $ok;
                                                                                                }

                                1                                                               ;
Und ja ich habe gerade nichts anderes zu tun. :-)

View full thread Mysql und Perl