Schrift
[thread]10570[/thread]

MySQL und Perl (Seite 4)

Leser: 3


<< |< 1 2 3 4 5 6 7 8 >| >> 72 Einträge, 8 Seiten
H3llGhost
 2007-10-16 23:29
#100941 #100941
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Hier geht die perl.plib weiter:

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
sub doConf
{
        my ($conf, %directives) = @_;
        
        while (($directive, $variable) = each(%directives))
        {
        if ($directive eq "Servers") {
              %$variable = $conf->get($directive);
        } else {
                  $$variable = $conf->get($directive);
            }
        }

}


#
# string abbreviate (string thestring[, int maxlength)
#
# Returns thestring abbreviated to maxlength-3 characters plus "...", unless
# thestring is shorter than maxlength.
#

sub abbreviate
{
        my ($thestring, $maxlength) = @_;
        
        $maxlength = 12  unless ($maxlength);
        
        if (length($thestring) > $maxlength)
        {
                $thestring = substr($thestring, 0, $maxlength - 3);
                return "$thestring...";
        }
        else
        {
                return $thestring;
        }
}


1;


Hier ist die configreader...:
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
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
package ConfigReaderSimple;
#
# Simple interface to a configuration file
#

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();

$VERSION = "1.0";

my $DEBUG = 0;

=head1 NAME

ConfigReader::Simple - Simple configuration file parser

=head1 SYNOPSIS

   use ConfigReader::Simple;

   $config = ConfigReader::Simple->new("configrc", [qw(Foo Bar Baz Quux)]);

   $config->parse();
   
   $config->get("Foo");
   

=head1 DESCRIPTION

   C<ConfigReader::Simple> reads and parses simple configuration files. It's
   designed to be smaller and simpler than the C<ConfigReader> module
   and is more suited to simple configuration files.

=cut

###################################################################
# Functions under here are member functions                       #
###################################################################

=head1 CONSTRUCTOR

=item new ( FILENAME, DIRECTIVES )

This is the constructor for a new ConfigReader::Simple object.

C<FILENAME> tells the instance where to look for the configuration
file.

C<DIRECTIVES> is an optional argument and is a reference to an array.  
Each member of the array should contain one valid directive. A directive
is the name of a key that must occur in the configuration file. If it
is not found, the module will die. The directive list may contain all
the keys in the configuration file, a sub set of keys or no keys at all.

=cut

sub new {
   my $prototype = shift;
   my $filename = shift;
   my $keyref = shift;

   my $class = ref($prototype) || $prototype;
   my $self  = {};

   $self->{"filename"} = $filename;
   $self->{"validkeys"} = $keyref;

   bless($self, $class);
   return $self;
}


#
# destructor
#
sub DESTROY {
   my $self = shift;

   return 1;
}

=pod
=item parse ()

This does the actual work.  No parameters needed.

=cut

sub parse {
   my $self = shift;

   open(CONFIG, $self->{"filename"}) || 
      die "Config: Can't open config file " . $self->{"filename"} . ": $!";

   my @array_buffer;
   my $ext_option = 0;
   my $parsed_line = 0;
 
   while (<CONFIG>) {
      chomp;
      next if /^\s*$/;  # blank
      next if /^\s*#/;  # comment

      $parsed_line   = 0;
      my $input_text = $_;
      
      if (/^\s*.*\[[0-9]+\]\s*=\s*\(/)  {
        $ext_option++;
      } elsif (/^.*\)/)  {
        push (@array_buffer, $_);
        my ($key, %values) = &parse_array(@array_buffer);
        warn "Key:  '$key'   Value:  '%values'\n" if $DEBUG;
        my $address = $values{"AddressPort"};
        if ($address eq "") {
          die ("No Address for server found!");
        }  
        %{$self->{"config_data"}{$key}{"$address"}} = %values;
        $ext_option = 0;
        $parsed_line++;
        @array_buffer = ();
      }
      
      if (($ext_option == 0) && ($parsed_line == 0)) {
        my ($key, $value) = &parse_line($input_text);
        warn "Key:  '$key'   Value:  '$value'\n" if $DEBUG;
        $self->{"config_data"}{$key} = $value;
      } elsif ($ext_option > 0) {
        push (@array_buffer, $_);
      }
   }
   close(CONFIG);
   #$self->_validate_keys;

   return 1;

}

=pod
=item get ( DIRECTIVE )

Returns the parsed value for that directive.

=cut

sub get {
   my $self = shift;
   my $key = shift;

   unless (ref $self->{"config_data"}{$key}) {
     return $self->{"config_data"}{$key};
   } else {
     return %{$self->{"config_data"}{$key}};
   }  
}

# Internal methods

sub parse_line {
   my $text = shift;

   my ($key, $value);
   
   if ($text =~ /^\s*(\w+)\s+(['"]?)(.*?)\2\s*$/) {
      $key   = $1;
      $value = $3;
   } else {
      die "Config: Can't parse line: $text\n";
   }

   return ($key, $value);
}

sub parse_array {
   my @array_buffer = @_;
   
   my ($key, %values);

   foreach my $entry (@array_buffer) 
   {
     if ($entry =~ /^\s*(.*)\[[0-9]+\]\s*=\s*\(\s*("(.+)"\s*=\>\s*"(.+)")?/ ) {
       $key = $1;
       $values{$3} = $4;
       
     } elsif ($entry =~ /^\s*"(.+)"\s*=\>\s*"(.+)"([,)]?)?/ ) {
       $values{$1} = $2;
     }
   }
   return ($key, %values);
}


=pod

=item _validate_keys ( )

If any keys were declared when the object was constructed,
check that those keys actually occur in the configuration file.

=cut


sub _validate_keys {
        
   my $self = shift;
   
        if ( $self->{"validkeys"} )
        {
          my ($declared_key);
          my $declared_keys_ref = $self->{"validkeys"};
      foreach $declared_key ( @$declared_keys_ref )
      {
        unless ( $self->{"config_data"}{$declared_key} )
        {
                die "Config: key '$declared_key' does not occur in file $self->{filename}\n";
        }
         warn "Key: $declared_key found.\n" if $DEBUG;
      }
        }

   return 1;
}

=pod

=head1 LIMITATIONS/BUGS

Directives are case-sensitive.

If a directive is repeated, the first instance will silently be
ignored.

Always die()s on errors instead of reporting them.

C<get()> doesn't warn if used before C<parse()>.

C<get()> doesn't warn if you try to acces the value of an
unknown directive not know (ie: one that wasn't passed via C<new()>).

All these will be addressed in future releases.

=head1 CREDITS

Kim Ryan <kimaryan@ozemail.com.au> adapted the module to make declaring
keys optional.  Thanks Kim.

=head1 AUTHORS

Bek Oberin <gossamer@tertius.net.au>

=head1 COPYRIGHT

Copyright (c) 2000 Bek Oberin.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

#
# End code.
#
1;


Das ist glaube ich alles ...
H3llGhost
 2007-10-17 20:46
#100990 #100990
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
War das jetzt zu viel Code? *ggg*
Oder ist euch nun der Faden abhanden gekommen?
H3llGhost
 2007-10-17 23:37
#100994 #100994
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Hallo Leute,

ich habe wohl nun den Jackpot geknackt ... ;)

Hier ist der Code:

Code: (dl )
1
2
3
4
5
6
	# mit jedem Durchlauf gibt es eine neue Variable $hash_ref mit eigener Speicheradresse
while ( my $hash_ref = $result->fetchrow_hashref() ) {
# $hash_ref nicht dereferenzieren, weil wir einen AoH aufbauen; perldoc perldsc
$g_config_servers[ $hash_ref->{'serverId'} ] = $hash_ref;
print $hash_ref;
}


Ein ganz kleiner Fehler und sehr große Auswirkung ... xD
H3llGhost
 2007-11-04 18:13
#101840 #101840
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Äh ne kleine Frage am Rande:
Warum wird dabei nichts ausgeben:

Code (perl): (dl )
1
2
3
4
5
6
7
8
        # mit jedem Durchlauf gibt es eine neue Variable $hash_ref mit eigener Speicheradresse
        while ( my $hash_ref = $result->fetchrow_hashref() ) {
        # $hash_ref nicht dereferenzieren, weil wir einen AoH aufbauen; perldoc perldsc
                $g_config_servers[ $hash_ref->{'serverId'} ] = $hash_ref;
                print $hash_ref->{'serverId'};
        }

print $g_config_servers{1};


Liegt es vielleicht daran:

Code (perl): (dl )
%g_config_servers = ();
renee
 2007-11-04 18:58
#101841 #101841
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Zwischen einem Array und einem Hash ist ein himmelgroßer Unterschied!

Innerhalb der Schleife greifst Du auf ein Array zu:
$g_config_servers[ $hash_ref->{'serverId'} ] = $hash_ref;

Und danach auf einen Hash:print $g_config_servers{1};

Ich wette, Du verwendest kein Wiki:[tt]use strict[/tt]
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-11-04 19:05
#101842 #101842
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Warum danach auf einen Hash?
Ich will einfach nur den Inhalt von $g_config_servers mir anschauen.

Zu deinem use strict:

Code (perl): (dl )
1
2
use strict;
no strict 'vars';


Das wird benutzt.
Struppi
 2007-11-05 01:37
#101857 #101857
User since
2006-02-17
628 Artikel
BenutzerIn
[Homepage]
user image
H3llGhost+2007-11-04 18:05:03--
Zu deinem use strict:

Code (perl): (dl )
1
2
use strict;
no strict 'vars';


Das wird benutzt.
Naja, mit dem no strict schaltest du es quasi wieder aus. Lass dir von Perl helfen, das macht das programieren einfacher.
renee
 2007-11-05 08:19
#101865 #101865
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
H3llGhost+2007-11-04 18:05:03--
Warum danach auf einen Hash?
Ich will einfach nur den Inhalt von $g_config_servers mir anschauen.


Warum?? Das musst *Du* wissen warum Du das so machst...

Ein gutes Modul, um sich den Inhalt von komplexen Datenstrukturen anzuschauen, ist CPAN:Data::Dumper.
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-11-05 19:55
#101887 #101887
User since
2007-10-14
60 Artikel
BenutzerIn
[default_avatar]
Jetzt bin ich vollkommen durcheinander ...
Ich möchte die Werte die in der Variable $result stehen vernünftig verarbeiten, aber da scheint ja der fetchrow_hashref die falsche Funktion zu sein, denn ich möchte gerne die Werte als richtige Klartextwerte speichern und nicht als Hashes ...
Was mache ich falsch bzw. verstehe ich falsch?

EDIT:

Mir ist gerade was aufgefallen ...
Ich brauche ein assoziatives Array ...
Wie kann ich das aus der DB-Tabelle machen?

Würde euch ja gerne helfen mit der Struktur aber ich weiß nicht wie die Struktur ist und ich weiß auch nicht wie ich das ausgeben kann ...

Habe nun herausgefunden, dass ich die Daten mit
Code (perl): (dl )
print ($g_config_servers{"77.237.250.200:27015"}{"MinPlayers"});

abrufen kann.
Aber wie dann das Array aufgebaut wird, da habe ich keine Ahnung und brauch eure Hilfe!
pq
 2007-11-05 21:09
#101890 #101890
User since
2003-08-04
12208 Artikel
Admin1
[Homepage]
user image
H3llGhost+2007-11-05 18:55:16--
Mir ist gerade was aufgefallen ...
Ich brauche ein assoziatives Array ...

in perl ist das ein hash.
renee hat dir ja schon Data::Dumper empfohlen.
in der doku steht:
Code (perl): (dl )
1
2
3
4
    use Data::Dumper;

    # simple procedural interface
    print Dumper($foo, $bar);

guck dich doch mal etwas bei uns im wiki um. perlintro etc.
Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live. -- Damian Conway in "Perl Best Practices"
lesen: Wiki:Wie frage ich & perlintro Wiki:brian's Leitfaden für jedes Perl-Problem
<< |< 1 2 3 4 5 6 7 8 >| >> 72 Einträge, 8 Seiten



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