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

Regex matched nicht (Seite 3)

Tags: Ähnliche Threads

Leser: 2


<< |< 1 2 3 >| >> 25 Einträge, 3 Seiten
FlorianL
 2008-03-18 16:45
#107211 #107211
User since
2007-05-18
142 Artikel
BenutzerIn
[default_avatar]
Wollte es der vollständigkeit halber mal posten, schlag mich nich, ich weiss das es teilweise echt schräg iss ;)

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
#!/usr/bin/perl
#
# Script zur abfrage auf neue Patches bei IBM
#
# Author: Florian L*****  - 15.03.08
#
# Usage: ./checkupdate.pl -s(ilent)
#
#################################################
use strict;         #
use LWP::UserAgent; #
use HTTP::Request;  #
use WWW::Mechanize; #
#####################

##########
# CONFIG #
##########

my $receiver = 'florian@***.de';                                          # Mail Receiver
my $proxy = 'http://***:***@***.de:8080/';       # Proxy Authentification
my $sendnews = "1";                                                             # Send Mails
my $sendnone = "1";                                                             # Send Mails on no new updates
my $datfile  = ".ibm_update.dat";                                               # Define the data-file

#########################################
####### DONT EDIT BELOW THIS LINE #######
#########################################

my $silent  = $ARGV[0];
my $date    = scalar(localtime);
my $browser = LWP::UserAgent->new;
$browser->timeout(10);
$browser->proxy( [ 'http', 'ftp' ], $proxy ) if defined $proxy;
$browser->cookie_jar( {} );

open( CHECKFILE, "<", $datfile );
my @checkarray = <CHECKFILE>;
close(CHECKFILE);
chomp(@checkarray);
my @mailresult;
my $gotnew;
if   ( $sendnone == 1 ) { $gotnew = 1; }
else                    { $gotnew = 0; }

open( FILE, ">", $datfile );

if ( $silent eq "-s" ) { }
else { print("Checking for new Versions...\n-----------------------------\n"); }

my $hmc_request = HTTP::Request->new( 'GET',
    "http://www14.software.ibm.com/webapp/set2/sas/f/hmc/home.html" );
my $hmc_response = $browser->request($hmc_request);
if ( $hmc_response->is_success() ) {
    my @hmc_site = $hmc_response->content;
    foreach (@hmc_site) {
        my $line = $_;
        if ( $line =~ m/HMC V7 (.+)<\/a>/g ) {
            if ( $1 eq $checkarray[0] ) {
                if ( $silent eq "-s" ) {
                    push( @mailresult,
                        "No new HMC Version online: (HMC V7 $checkarray[0])\n\n"
                    );
                    print FILE "$1\n";
                }
                else {
                    print("No new HMC Version online\n");
                    print FILE "$1\n";
                    push( @mailresult, "No new HMC Version online\n" );
                }
            }
            else {
                if ( $silent eq "-s" ) {
                    $gotnew = 1;
                    push( @mailresult, "HMC Version: HMC V7 $1\n" );
                    print FILE "$1\n";
                }
                else {
                    $gotnew = 1;
                    print("HMC Version: HMC V7 $1\n");
                    print FILE "$1\n";
                    push( @mailresult, "HMC Version: HMC V7 $1\n" );
                }
            }
        }
    }
}
else {
    print "ERROR " . $hmc_response->message . "\n";
}

my $mech = WWW::Mechanize->new();
$mech->proxy( [ 'http', 'ftp' ], $proxy );
$mech->get(
    'http://www-912.ibm.com/eserver/support/fixes/fixcentral/pfixpacks/53');
$mech->submit_form(
    form_name => 'tlFilter',
    fields    => { tl => 'all', },
    button    => 'go'
);
my @fix_site = $mech->content;
foreach (@fix_site) {
    my $line = $_;
    if ( $line =~ m/pseriesfixpackinformation\/(.+)\"/g ) {
        if ( $checkarray[1] eq $1 ) {
            if ( $silent eq "-s" ) {
                push( @mailresult,
                    "No new Fixpack online: (Fixpack $checkarray[1])\n\n" );
                print FILE "$1\n";
            }
            else {
                print("No new Fixpack online\n");
                print FILE "$1\n";
                push( @mailresult, "No new Fixpack online\n" );
            }
        }
        else {
            if ( $silent eq "-s" ) {
                $gotnew = 1;
                push( @mailresult, "Fixpack: $1\n" );
                print FILE "$1\n";
            }
            else {
                $gotnew = 1;
                print("Fixpack: $1\n");
                print FILE "$1\n";
                push( @mailresult, "Fixpack: $1\n" );
            }
        }
    }
}

my $vios_request = HTTP::Request->new( 'GET',
    "http://www14.software.ibm.com/webapp/set2/sas/f/vios/download/home.html" );
my $vios_response = $browser->request($vios_request);
if ( $vios_response->is_success() ) {
    my @vios_site = $vios_response->content;
    foreach (@vios_site) {
        my $line = $_;
        if ( $line =~ m/Fix&nbsp;Pack&nbsp;(.+)<\/a>/g ) {
            if ( $checkarray[2] eq $1 ) {
                if ( $silent eq "-s" ) {
                    push( @mailresult,
"No new Vios Updates online: (Vios Fixpack $checkarray[2])\n\n"
                    );
                    print FILE "$1\n";
                }
                else {
                    print("No new Vios Updates online.\n");
                    print FILE "$1\n";
                    push( @mailresult, "No new Vios Updates online.\n" );
                }
            }
            else {
                if ( $silent eq "-s" ) {
                    $gotnew = 1;
                    push( @mailresult, "Vios Fixpack: $1\n" );
                    print FILE "$1\n";
                }
                else {
                    $gotnew = 1;
                    print("Vios Fixpack: $1\n");
                    print FILE "$1\n";
                    push( @mailresult, "Vios Fixpack: $1\n" );
                }
            }
        }
    }
}
else {
    print "ERROR " . $vios_response->message . "\n";
}

if ( $sendnews == 1 ) {
    if ( $gotnew == 1 ) {
        open( SENDMAIL, "|/usr/sbin/sendmail -t" )
          || &fehler("Sendmail not Found!\n");
        print SENDMAIL <<EOF;
To: $receiver
Subject: IBM Patch Info - $date
From: root\@xadmp01
Content-Type: text/plain; charset="iso-8859-1"
Content-Transfer-Encoding: 8bit

Checking for new Patches on IBM
-------------------------------

 @mailresult
.
EOF
        close(SENDMAIL);
    }
}
Gast Gast
 2008-03-19 00:51
#107214 #107214
Direkt ins Auge gestochen sind mir Dinge wie:
Code: (dl )
1
2
if ( $silent eq '-s' ) { }
else { ... }

Das sieht imo so besser aus:
Code: (dl )
if ( $silent ne '-s' ) { ... }

Und:
Code: (dl )
1
2
3
foreach ( ... ) {
my $line = $_;
...

Das kann ( und sollte ) man auch so schreiben:
Code: (dl )
1
2
foreach my $line ( ... ) {
...

Aber auch:
Code: (dl )
1
2
if   ( $sendnone == 1 ) { $gotnew = 1; }
else { $gotnew = 0; }

Das kann man imho so besser ausdrücken:
Code: (dl )
$gotnew = $sendnone == 1 ? 1 : 0;

Ausserdem ist es ratsam lexikalische Filehandles zu verwenden und du solltest FILE explizit schließen ( oder hab ich das übersehen? ).
Ein paar mehr Leerzeilen würden die Leesbarkeit fördern und du brauchst das /g Flag bei deinen regulären Ausdrücken nicht.

MfG
FlorianL
 2008-03-19 11:00
#107226 #107226
User since
2007-05-18
142 Artikel
BenutzerIn
[default_avatar]
Vielen dank für die Tipps :)
moritz
 2008-03-19 11:31
#107230 #107230
User since
2007-05-11
923 Artikel
HausmeisterIn
[Homepage]
user image
Gast+2008-03-18 23:51:08--
Code: (dl )
1
2
3
foreach ( ... ) {
my $line = $_;
...

Das kann ( und sollte ) man auch so schreiben:
Code: (dl )
1
2
foreach my $line ( ... ) {
...


Das stimmt, aber die Semantik ist unterschiedlich.

Im ersten Fall ändert sich das Array nicht, über das iteriert wird, wenn man $line einen Wert zuweist. im zweiten Fall ändert es sich.

Nur so als kleine Randbemerkung.
Gast Gast
 2008-03-20 11:26
#107291 #107291
Ahh... stimmt. Daran hatte ich nicht gedacht, aber es macht in dem Code ja keinen Unterschied :)

MfG
<< |< 1 2 3 >| >> 25 Einträge, 3 Seiten



View all threads created 2008-03-13 15:51.