Schrift
Wiki:Tipp zum Debugging: use Data::Dumper; local $Data::Dumper::Useqq = 1; print Dumper \@var;
[thread]10570[/thread]

MySQL und Perl (Seite 3)

Leser: 3


<< |< 1 2 3 4 5 6 ... 8 >| >> 72 Einträge, 8 Seiten
H3llGhost
 2007-10-16 01:50
#100895 #100895
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Ist nicht schlimm denn der Eindruck ist fast richtig ...
Ich habe gerade mal in die Doku reingeschaut weil mir das hashref so komisch vorkommt.
Weil für mich ist ein Hash diese komische Zusammensetzung aus Zeichen ... :D
Ansonsten habe ich mich damit noch nie wirklich auseinandergesetzt, da der Skript nicht von mir kommt, sondern ein fertiger ist und ich ihn ein bisschen abänderen möchte ... ;)

Und die Links die du mir geschickt hattest die hatte ich auch gelesen ... ;)

Ich bin der Meinung, dass man select... nicht braucht, da "prepare", "execute" and "fetchrow_hashref" das schon von den doquery teilweise gemacht wird ...
Es muss leglich nur der fetchrow... noch benutzt werden ...

Wenn ich das selectrow durch ein fetchrow ersetze kommt folgender Fehler:

Can't locate object method "fetchrow_hashref" via package "DBI::db" ...

Für mich heißt das auf gut Deutsch, dass er die Methode fetchrow_hashref nicht finden kann ...
Eingebunden wird das DBI aber folgendermaße:
Code (perl): (dl )
use DBI;


Ich weiß nicht ob das falsch ist bzw. nicht alles einbindet.
So das ist alles was ist jetzt so weiß ... ;)
renee
 2007-10-16 10:29
#100899 #100899
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Zeig mal mehr Code... Machst Du "fetchrow_hashref" mit dem Datenbankhandle (meist $dbh genannt)?
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
Strat
 2007-10-16 14:21
#100905 #100905
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
Lies dir vielleicht mal http://www.fabiani.net -> Perl -> Perl-Enhanced -> MySql mit DBI durch...
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
Gast Gast
 2007-10-16 14:30
#100906 #100906
Hallo,

so mache ich das:

Code (perl): (dl )
1
2
3
[...]
while ( my $hash_ref = $db_conn->fetchrow_hashref( $result ) )
[...]
Gast Gast
 2007-10-16 14:37
#100908 #100908
(at) Strat:
Danke für den Link ...
Also sollte ich lieber folgendes benutzen?

Code (perl): (dl )
while ( my $result = $sth->fetchrow_hashref() )


Und danach eine foreach-Schleife machen?
renee
 2007-10-16 14:51
#100909 #100909
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Wieso danach noch eine foreach-Schleife? Mit der while-Schleife holst Du doch schon alle Datensätze...
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
H3llGhost
 2007-10-16 18:10
#100920 #100920
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Weil ich ja vorhabe das Array

Code: (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
Servers[0] = ("AddressPort"                    => "xxx.xxx.xxx.xxx:xxxxx", 
"MinPlayers" => "6",
"AdminContact" => "webmaster@battle55-stats.de",
"HLStatsURL" => "http://www.battle55-stats.de",
"DisplayResultsInBrowser" => "0",
"MasterServerData" => "7",
"MasterServerInterval" => "200",
"BroadCastEvents" => "0",
"BroadCastPlayerActions" => "0",
"BroadCastEventsCommand" => "say",
"BroadCastEventsCommandSteamid" => "0",
"BroadCastEventsCommandAnnounce" => "say",
"PlayerEvents" => "1",
"PlayerEventsCommand" => "say",
"PlayerEventsCommandSteamid" => "0",
"PlayerEventsCommandOSD" => "",
"PlayerEventsAdminCommand" => "",
"ShowStats" => "1",
"TKPenalty" => "50",
"SuicidePenalty" => "5",
"AutoTeamBalance" => "0",
"AutoBanRetry" => "0",
"TrackServerLoad" => "1",
"MinimumPlayersRank" => "0",
"Admins" => "",
"SwitchAdmins" => "0",
"IgnoreBots" => "1",
"SkillMode" => "0",
"GameType" => "0",
"EnablePublicCommands" => "1",
"Mod" => "")


So zu erstellen nur halt aus einer Datenbank heraus ...
Wie würdest du das denn machen renee?
H3llGhost
 2007-10-16 19:31
#100932 #100932
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Mir ist gerade eine Zeile im Code aufgefallen:

Code (perl): (dl )
%g_config_servers = ();


Ich weiß zwar nicht genau, was das bedeutet, aber ich denke, das muss mit in die while-Schleife eingebracht werden ... oder?
renee
 2007-10-16 20:44
#100935 #100935
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Du musst Du uns schon mehr Code bieten...
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
H3llGhost
 2007-10-16 23:28
#100940 #100940
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Hier das Hauptdokument:

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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
#!/usr/bin/perl

use strict;
no strict 'vars';

##
## Settings
##

# $opt_configfile - Absolute path and filename of configuration file.
$opt_configfile = "./perl.conf";

# $opt_libdir - Directory to look in for local required files
#               (our *.plib, *.pm files).
$opt_libdir = "./";


##
##
################################################################################
## No need to edit below this line
##

use Getopt::Long;
use Time::Local;
use IO::Socket;
use IO::Select;
use DBI;
use Digest::MD5;

require "$opt_libdir/ConfigReaderSimple.pm";
do "$opt_libdir/perl.plib";

$|=1;
Getopt::Long::Configure ("bundling");


$last_trend_timestamp = 0;

##
## MAIN
##

# Options

$opt_help = 0;
$opt_version = 0;

$db_host = "localhost";
$db_user = "";
$db_pass = "";
$db_name = "";
$db_lowpriority = 1;

$s_ip = "";
$s_port = "27500";

$g_mailto = "";
$g_mailpath = "/bin/mail";
$g_mode = "Normal";
$g_deletedays = 5;
$g_minactivity = 28;
$g_requiremap = 0;
$g_debug = 1;
$g_nodebug = 0;
$g_rcon = 1;
$g_rcon_ignoreself = 0;
$g_rcon_record = 1;
$g_stdin = 0;
$g_server_ip = "";
$g_server_port = 27015;
$g_timestamp = 0;
$g_dns_resolveip = 1;
$g_dns_timeout = 5;
$g_skill_maxchange = 100;
$g_skill_minchange = 2;
$g_player_minkills = 50;
$g_bot_ids = "BOT:0";
$g_onlyconfig_servers = 1;
$g_track_stats_trend = 0;
%g_lan_noplayerinfo = ();
%g_preconnect = ();
$g_global_banning = 0;
$g_masterserver_address = "";
$g_masterserver_port    = "";
$g_statsserver_address  = "";
$g_statsserver_port     = "";
$g_log_chat = 0;
$g_log_chat_admins = 0;
$g_global_chat = 0;

# Usage message

$usage = <<EOT

EOT
;

%g_config_servers = ();

# Read Config File

if ($opt_configfile && -r $opt_configfile)
{
        $conf = ConfigReaderSimple->new($opt_configfile);
        $conf->parse();
        
        %directives = (
                "DBHost",                         "db_host",
                "DBUsername",             "db_user",
                "DBPassword",             "db_pass",
                "DBName",                         "db_name",
                "DBUsername2",            "db_user2",
                "DBPassword2",            "db_pass2",
                "DBName2",                        "db_name2",
                "DBLowPriority",          "db_lowpriority",
                "BindIP",                         "s_ip",
                "Port",                           "s_port",
                "MailTo",                         "g_mailto",
                "MailPath",                       "g_mailpath",
                "Mode",                           "g_mode",
                "DeleteDays",             "g_deletedays",
                "MinActivity",            "g_minactivity",
                "DebugLevel",             "g_debug",
                "UseTimestamp",           "g_timestamp",
                "DNSResolveIP",           "g_dns_resolveip",
                "DNSTimeout",             "g_dns_timeout",
                "RconIgnoreSelf",         "g_rcon_ignoreself",
                "Rcon",                               "g_rcon",
                "RconRecord",             "g_rcon_record",
                "MinPlayers",             "g_minplayers",
                "SkillMaxChange",         "g_skill_maxchange",
                "SkillMinChange",         "g_skill_minchange",
                "PlayerMinKills",         "g_player_minkills",
                "AllowOnlyConfigServers", "g_onlyconfig_servers",
                "TrackStatsTrend",        "g_track_stats_trend",
                "GlobalBanning",          "g_global_banning",
        "LogChat",                "g_log_chat",
        "LogChatAdmins",          "g_log_chat_admins",
        "GlobalChat",             "g_global_chat"
        );
        &doConf($conf, %directives);
        #,              #"Servers",                "g_config_servers"

# Connect to the database

$db_conn = DBI->connect(
        "DBI:mysql:$db_name:$db_host",
        $db_user, $db_pass
) or die ("\nCan't connect to MySQL database '$db_name' on '$db_host'\n" .
        "Server error: $DBI::errstr\n");

&printEvent("MYSQL", "Connecting to MySQL database '$db_name' on '$db_host' as user '$db_user' ... connected ok", 1);

$db_conn2 = DBI->connect(
        "DBI:mysql:$db_name2:$db_host",
        $db_user2, $db_pass2
) or die ("\nCan't connect to Global MySQL database '$db_name2' on '$db_host2'\n" .
        "Server error: $DBI::errstr\n");

&printEvent("MYSQL", "Connecting to Global MySQL database '$db_name2' on '$db_host' as user '$db_user2' ... connected ok", 1);
        
    my $query = "
            SELECT
                    *
            FROM
                    hlstats_Servers
    ";
    my $result = &doQuery($query);
    my $hash_ref;
 
        # mit jedem Durchlauf gibt es eine neue Variable $hash_ref mit eigener Speicheradresse
        while ( my $hash_ref = $db_conn->fetchrow_hashref( $result ) ) {
        # $hash_ref nicht dereferenzieren, weil wir einen AoH aufbauen; perldoc perldsc
                $g_config_servers[ $hash_ref->{'serverId'} ] = $hash_ref;
                print $hash_ref;
        }


Hier ist die perl.plib:

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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
# Release version number

$VERSION = "0.20";
$g_version = $VERSION;

##
## Common Functions
##

sub number_format {
  local $_  = shift;
  1 while s/^(-?\d+)(\d{3})/$1,$2/;
  return $_;
}

sub date_format {
  my $timestamp = shift;
  return sprintf('%dd %02d:%02d:%02dh', 
                  $timestamp / 86400, 
                  $timestamp / 3600 % 24, 
                  $timestamp / 60 % 60, 
                  $timestamp % 60 
                 );     
}



#
# void error (string errormsg)
#
# Dies, and optionally mails error messages to $g_mailto.
#

sub error
{
        my $errormsg = $_[0];
        
        if ($g_mailto && $g_mailpath)
        {
                system("echo \"$errormsg\" | $g_mailpath -s \"Perl crashed `date`\" $g_mailto");
        }

        die("$errormsg\n");
}


#
# string quoteSQL (string varQuote)
#
# Escapes all quote characters in a variable, making it suitable for use in an
# SQL query. Returns the escaped version.
#

sub quoteSQL
{
        my $varQuote = $_[0];

        $varQuote =~ s/\\/\\\\/g;       # replace \ with \\
        $varQuote =~ s/'/\\'/g;         # replace ' with \'
        
        return $varQuote;
}

#
# result doQuery (string query)
#
# Executes the SQL query 'query' and returns the result identifier.
#

sub doQuery
{
        my ($query, $callref) = @_;

        my $result = $db_conn->prepare($query) or die("Unable to prepare query:\n$query\n$DBI::errstr\n$callref");
        $result->execute or die("Unable to execute query:\n$query\n$DBI::errstr\n$callref");
        return $result;
}

sub doQuery2
{
        my ($query, $callref) = @_;

        my $result = $db_conn2->prepare($query) or die("Unable to prepare query:\n$query\n$DBI::errstr\n$callref");
        $result->execute or die("Unable to execute query:\n$query\n$DBI::errstr\n$callref");
        return $result;
}


#
# string resolveIp (string ip, boolean quiet)
#
# Do a DNS reverse-lookup on an IP address and return the hostname, or empty
# string on error.
#

sub resolveIp
{
        my ($ip, $quiet) = @_;
        my ($host) = "";
        
        unless ($g_dns_resolveip)
        {
                return "";
        }
        
        
        eval
        {
                $SIG{ALRM} = sub { die "DNS Timeout\n" };
                alarm $g_dns_timeout;   # timeout after $g_dns_timeout sec
                $host = gethostbyaddr(inet_aton($ip), AF_INET);
                alarm 0;
        };
        
        if ($@)
        {
                my $error = $@;
                chomp($error);
        printEvent("DNS", "Resolving hostname (timeout $g_dns_timeout sec) for IP \"$ip\" - $error ", 1);
                $host = "";             # some error occurred
        }
        elsif (!defined($host))
        {
        printEvent("DNS", "Resolving hostname (timeout $g_dns_timeout sec) for IP \"$ip\" - No Host ", 1);
                $host = "";             # ip did not resolve to any host
        } else {
          $host = lc($host);    # lowercase
      printEvent("DNS", "Resolving hostname (timeout $g_dns_timeout sec) for IP \"$ip\" - $host ", 1);
        }
        chomp($host);
        return $host;
}


#
# object queryHostGroups ()
#
# Returns result identifier.
#

sub queryHostGroups
{
        return &doQuery("
                SELECT
                        pattern,
                        name,
                        LENGTH(pattern) AS patternlength
                FROM
                        hlstats_HostGroups
                ORDER BY
                        patternlength DESC,
                        pattern ASC
        ");
}


#
# string getHostGroup (string hostname[, object result])
#
# Return host group name if any match, or last 2 or 3 parts of hostname.
#

sub getHostGroup
{
        my ($hostname, $result) = @_;
        my $hostgroup = "";
        
        # User can define special named hostgroups in hlstats_HostGroups, i.e.
        # '.adsl.someisp.net' => 'SomeISP ADSL'
        
        $result = &queryHostGroups()  unless ($result);
        $result->execute();
        
        while (my($pattern, $name) = $result->fetchrow_array())
        {
                $pattern = quotemeta($pattern);
                $pattern =~ s/\\\*/[^.]*/g;     # allow basic shell-style globbing in pattern
                if ($hostname =~ /$pattern$/)
                {
                        $hostgroup = $name;
                        last;
                }
        }
        
        if (!$hostgroup)
        {
                #
                # Group by last 2 or 3 parts of hostname, i.e. 'max1.xyz.someisp.net' as
                # 'someisp.net', and 'max1.xyz.someisp.net.nz' as 'someisp.net.nz'.
                # Unfortunately some countries do not have categorical SLDs, so this
                # becomes more complicated. The dom_nosld array below contains a list of
                # known country codes that do not use categorical second level domains.
                # If a country uses SLDs and is not listed below, then it will be
                # incorrectly grouped, i.e. 'max1.xyz.someisp.yz' will become
                # 'xyz.someisp.yz', instead of just 'someisp.yz'.
                #
                # Please mail sgarner@hlstats.org with any additions.
                #
                
                my @dom_nosld = (
                        "ca", # Canada
                        "ch", # Switzerland
                        "be", # Belgium
                        "de", # Germany
                        "ee", # Estonia
                        "es", # Spain
                        "fi", # Finland
                        "fr", # France
                        "ie", # Ireland
                        "nl", # Netherlands
                        "no", # Norway
                        "ru", # Russia
                        "se", # Sweden
                );
                
                my $dom_nosld = join("|", @dom_nosld);
                
                if ($hostname =~ /([\w-]+\.(?:$dom_nosld|\w\w\w))$/)
                {
                        $hostgroup = $1;
                }
                elsif ($hostname =~ /([\w-]+\.[\w-]+\.\w\w)$/)
                {
                        $hostgroup = $1;
                }
                else
                {
                        $hostgroup = $hostname;
                }
        }
        
        return $hostgroup;
}


#
# void doConf (object conf, hash directives)
#
# Walk through configuration directives, setting values of global variables.
#
<< |< 1 2 3 4 5 6 ... 8 >| >> 72 Einträge, 8 Seiten



View all threads created 2007-10-14 17:05.