Toon posts:

Perl Database probleem

Pagina: 1
Acties:

Verwijderd

Topicstarter
Hallo, ik ben bezig een site te bouwen waarop mensen een advertentie kunnen plaatsen/verwijderen. Hiervoor heb ik een script gekocht welke ik heb ge-edit.. Maar nu gebeurd er iets vreemds. Als iemand een advertentie in een (dan nog lege) categorie plaatst met telefoonnummer gaat alles goed maar als iemand een 2e advertentie plaats met telefoonnummer "steelt" het script het telefoonnummer weg bij de beide advertentie's! (bij beide regeltjes uit de database). Een stukje code:
code:
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
$timead = ($adexpire * 86400 + time);
if ($form{'PICYES'}) { $form{'PICURL'} = $form{'PICGAL'}; }
#&badword;
$whatturn = "dispitem";

if ($form{'CATEGORY'} =~ m/\&subcat/) {

@catman = split(/\&/, $form{'CATEGORY'});
#folder 0
#subcat 2
#maincat 3
$wopper = "$catman[0]/$catman[2]";
$form{'CATEGORY'} = $catman[0];
$category{$form{'CATEGORY'}} = "$catman[3] >> $catman[2]";

$whatturn = "subdispitem";
$didflag = 1;
}
else {
@catman2 = split(/\&/, $form{'CATEGORY'});
$wopper = $catman2[0];
}

if (!($didflag)) {
@catman = split(/\&/, $form{'CATEGORY'});
$category{$form{'CATEGORY'}} = $catman[1];
}

&oops('cannot access category database file') unless (open(REGFILE, "$basepath/categories/$wopper.dat"));
        (@change2) = <REGFILE>;
        close REGFILE;

$lines[0] = ();
$lines[0] = "$form{'TITLE'}|$form{'DESC'}|$form{'PICURL'}|$form{'BRANDSTOF'}|$form{'POSTCODE'}|$form{'USERNAME'}|$form{'LOCATE'}|$category{$form{'CATEGORY'}}|$timead|$form{'TELEFOONNUMMER'}\n";

foreach $bum(@change2) {

$lines[0].= "$bum";
}

    &oops('Cannot write ad') unless (open(NEWITEM, "+>$basepath/categories/$wopper.dat"));
flock(NEWREG, 2) if ($filelock);
        print NEWITEM "$lines[0]\n";
    flock(NEWREG, 8) if ($filelock);
        close NEWITEM;

De database ziet er normaal gesproken, dus zonder telefoonnummers zo uit:
code:
1
2
3-serie 318i|bouwjaar: 1991<BR>kleur: turmolyngroen metallic<BR>kilometerstand: 164000<BR>prijs in guldens: 13750,-<BR><BR>overig:<BR>4 Deurs. 16 inch velgen, 5 VERSNELINGEN, AFST ALARM, APK GEK, BENZ LPG, Centrale vergrendeling, INRUIL MOG, Stuurbekrachtiging, ww glas, ZEER MOOIE AUTO, ZEER SPORTIEF.|212.204.200.85/userpics/Meulenbroekautos/zl69zt.jpg|LPG|5222AH|Meulenbroekautos|&#8364; 6000 - &#8364; 7000|Merk >> BMW|1035374070
3-serie 318i|bouwjaar: 1992<BR>kleur: zwart metallic<BR>prijs in guldens: 13500,-<BR>overig:<BR>4 Deurs. 4 hoofdsteunen, 5 VERSNELINGEN, AFST ALARM, Benzine, Centrale vergrendeling, INRUIL MOG, Stuurbekrachtiging, ww glas, ZEER MOOIE AUTO, APK NIEUW|212.204.200.84/userpics/Meulenbroekautos/dtfx93.jpg|Benzine|5222AH|Meulenbroekautos|&#8364; 6000 - &#8364; 7000|Merk >> BMW|1035373847

Dit zijn dus 2 advertenties. Heeft iemand een idee waar het aan kan liggen? Ik ben helaas niet zo'n perl-expert.

Verwijderd

hmm ik ben niet super wakker meer, maar ik kan hier zo geen fout in vinden waarom hij het verkeerd zou doen.
Erg raar zou zijn dat als je alleen 1 item toevoegd dat ie dan een ander item zou wijzigen, slecht script in dat geval (denk ik dan)...
Zou erop neerkomen dat ie elke regel weer opnieuw zou moeten opbouwen, in nieuwe variable gaat zetten en terug schrijven, maar dat doet ie niet. Dit is niet alle code? MIsschien help wat meer code...

Verwijderd

Ik heb je code 3 keer over gelezen, maar kan hier echt geen fout in vinden... *D

Verwijderd

zie ook zo 1 2 3 de fout niet, wat je moet doen is gewoon op diverse plekken in het script ff het telefoonnummer variabele printen, dan kun je heel makkelijk opsporen waar hij ineens de verkeerde waarde krijgt

Verwijderd

Topicstarter
Ik zal voor het gemak de hele code geven, schik niet :)
code:
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
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
sub placead {
if (&GetCookies('name')) { $blip = $Cookies{'name'}; }
if (&GetCookies('name')) { $blop = "HiddenPass"; }

if (!($blip)) {

print "<CENTER>Please Login First</CENTER><P>";
&login2;
exit;
}


push (@cat, "<SELECT NAME=CATEGORY>\n");

if ($ARGV[2] eq "subcat") {
$ARGV[3] =~ s/\+/ /gm if ($ARGV[3]);
$ARGV[1] = "$ARGV[1]\&subcat\&$ARGV[3]\&$ARGV[4]";
$ARGV[3] = "$ARGV[4] >> $ARGV[3]";
} 
else {
$ARGV[3] =~ s/\+/ /gm if ($ARGV[3]);
$ARGV[1] = "$ARGV[1]\&$ARGV[3]";
}

$ARGV[3] =~ s/\+/ /gm if ($ARGV[3]);
        push(@cat, "<OPTION VALUE=\"$ARGV[1]\">$ARGV[3]</OPTION>\n") if ($ARGV[3]);
    foreach $key (sort keys %category) {

$main = $category{$key};
@apple2 = split(/,/, $category{$key});
$maincat = shift(@apple2);
        push(@cat, "<OPTION VALUE=\"$key\&$maincat\">$maincat</OPTION>\n");
#################################################################################
@apple = ();
if ($categorey{$key} =~ m/,/) { $subflag = 1; }
@apple = split(/,/, $category{$key});
$boner = shift(@apple);
foreach $thingy(@apple) {
$marksub = 0;
$thingy =~ s/ //;
$thingy =~ s/ /_/gm;
$thingy2 = $thingy;
$thingy2 =~ s/_/ /gm;
if (!($thingy eq "")) {
    push(@cat, "<OPTION VALUE=\"$key\&subcat\&$thingy\&$boner\">$maincat >> $thingy2</OPTION>\n");
}

}


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

}
if ($allowpic) {
push(@pic, "<input type=checkbox name=PICYES value=1><font color=#003366 size=2 face=Arial, Helvetica>Gebruik een afbeelding uit uw <A HREF=$ENV{'SCRIPT_NAME'}?gallery>foto archief</font></a><br><SELECT NAME=PICGAL>") if (&GetCookies('name'));

opendir THEDIR, "$picdir/$Cookies{'name'}" || die "Unable to open directory: $!";
    @allfiles = readdir THEDIR;
    closedir THEDIR;
    $numfiles = @allfiles;
    $numfiles = ($numfiles - 2);
    foreach $file (@allfiles) {
        if (-f "$picdir/$Cookies{'name'}/$file") {
        push (@pic, "<OPTION VALUE=\"$picurlpath$blip/$file\">$file</OPTION>\n") if (&GetCookies('name'));
}
}
}



&oops('Cannot Find placead PM') unless (open(THEFILE, "$basepath/templates/placead.pm"));
            (@register) = <THEFILE>;
            close THEFILE;

foreach $line(@register) {

$line =~ s/<!--CLASSPOST_URL-->/$classurl/;
$line =~ s/<!--CAT-->/@cat/gm;
$line =~ s/<!--PIC-->/@pic/gm;
$line =~ s/<!--BLIP-->/$blip/gm;
$line =~ s/<!--BLOP-->/$blop/gm;
$line =~ s/<!--FOOTER-->/@footer/gm;
}

print @register;


}

####################
##
## Process ad - Stop the press's
##

sub procad {
if (&GetCookies('name')) { $form{'USERNAME'} = $Cookies{'name'}; }
foreach $key (sort keys %category) {
        if (!(-e "$basepath/categories/$key.dat")) {
    &oops('Cannot create category database most likely a basepath error') unless (open NEWREG, ">>$basepath/categories/$key.dat");
            close NEWREG;

}

if ($category{$key} eq $category{$form{'CATEGORY'}}) {


$wopper = $key
} 


}

$newflag = 1;
if ($form{'PREVIEW'} eq "Preview") { 
&pread; 
$newflag = 0;
}
if ($newflag) {
    &oops('You didnt enter a DESCRIPTION') unless ($form{'DESC'});
    &oops('USERNAME') unless ($form{'USERNAME'});
    &oops('You didnt enter a TITLE') unless ($form{'TITLE'});
    &oops('PASSWORD') unless ($form{'PASSWORD'});
    &oops('You didnt enter a CATEGORY') unless ($form{'CATEGORY'});
&badword;
($formatted = $form{'TITLE'}) =~ s/<[^>]*>//gs;
$form{'TITLE'} = $formatted;
$URL = "http://$form{'PICURL'}";
$adtitle = ($adexpire * 86400 + time);
if (&GetCookies('name')) { $form{'USERNAME'} = $Cookies{'name'}; }

&oops('cannot access reg database file') unless (open(REGFILE, "$basepath/database/reg.dat"));
        (@change) = <REGFILE>;
        close REGFILE;
    
        $form{'USERNAME'} = lc($form{'USERNAME'});
        $form{'USERNAME'} = ucfirst($form{'USERNAME'});
$newtest = ();
$booba = scalar(@change);
$booba = $booba - 1;
$count = -1;
foreach $addy (@change) {
$count++;
@ripit = ();
@ripit = split(/\|/, $addy);

chomp($ripit[0]);
$ripit[0] =~ s/ //gm;
if ($form{'USERNAME'} eq "$ripit[0]") {
chomp($ripit[5]);
chomp($ripit[4]);
chomp($ripit[3]);
chomp($ripit[2]);
chomp($ripit[1]);
chomp($ripit[0]);
$ripit[0] =~ s/ //gm;
if (&GetCookies('name')) { $form{'PASSWORD'} = $ripit[4]; }


        &oops('invalid PASSWORD 1') unless ((lc $ripit[4]) eq (lc $form{'PASSWORD'}));
&checkamount;

$logged = 1;
}

}
}

if (!($logged)) {
print "no user found";
print @footer;
exit;
}


$timead = ($adexpire * 86400 + time);
if ($form{'PICYES'}) { $form{'PICURL'} = $form{'PICGAL'}; }
#&badword;
$whatturn = "dispitem";

if ($form{'CATEGORY'} =~ m/\&subcat/) {

@catman = split(/\&/, $form{'CATEGORY'});
#folder 0
#subcat 2
#maincat 3
$wopper = "$catman[0]/$catman[2]";
$form{'CATEGORY'} = $catman[0];
$category{$form{'CATEGORY'}} = "$catman[3] >> $catman[2]";

$whatturn = "subdispitem";
$didflag = 1;
}
else {
@catman2 = split(/\&/, $form{'CATEGORY'});
$wopper = $catman2[0];
}

if (!($didflag)) {
@catman = split(/\&/, $form{'CATEGORY'});
$category{$form{'CATEGORY'}} = $catman[1];
}

&oops('cannot access category database file') unless (open(REGFILE, "$basepath/categories/$wopper.dat"));
        (@change2) = <REGFILE>;
        close REGFILE;

$lines[0] = ();
$lines[0] = "$form{'TITLE'}|$form{'DESC'}|$form{'PICURL'}|$form{'BRANDSTOF'}|$form{'POSTCODE'}|$form{'USERNAME'}|$form{'LOCATE'}|$category{$form{'CATEGORY'}}|$timead|$form{'TELEFOONNUMMER'}\n";

foreach $bum(@change2) {

$lines[0].= "$bum";
}

    &oops('Cannot write ad') unless (open(NEWITEM, "+>$basepath/categories/$wopper.dat"));
flock(NEWREG, 2) if ($filelock);
        print NEWITEM "$lines[0]\n";
    flock(NEWREG, 8) if ($filelock);
        close NEWITEM;
if ($didflag) {
@trip = split(/\//, $wopper);
$wopper = $trip[0];
$theurl = "<a href=$classurl?$whatturn\&$wopper\&$timead\&$catman[2]>Hier</a>";
}

&oops('Cannot Find adsuccess PM') unless (open(THEFILE, "$basepath/templates/adsuccess.pm"));
            (@register) = <THEFILE>;
            close THEFILE;
$link = "<a href=$classurl?$whatturn\&$wopper\&$timead\&$catman[2]>Hier</a>";
$advertentienummer = "$timead";
foreach $line(@register) {

$line =~ s/<!--CLASSPOST_URL-->/$classurl/gm;
$line =~ s/<!--CAT-->/$category{$form{'CATEGORY'}}/gm;
$line =~ s/<!--LINK-->/$link/gm;
$line =~ s/<!--ADVERTENTIENUMMER-->/$advertentienummer/gm;
$line =~ s/<!--FOOTER-->/@footer/gm;



}

print @register;
&newsearch;

}

sub badword {
foreach $citem (@CENSORED) { $form{'DESC'} =~ s/\b$citem\b/\*\*\*/gi; 
#$form{'DESC'} =~ s/\n/<BR>/gm;
$form{'TITLE'} =~ s/\b$citem\b/\*\*\*/gi; 
} 




}


####################
##
## Preview the ad - Kinda like a sneak preview :D
##

sub pread {

$locate = $form{'LOCATE'};
$image = $form{'PICURL'} unless ($form{'PICYES'});
if ($form{'PICYES'}) { $image = $form{'PICGAL'}; }
if ($locate eq "") { $locate = "Not Applicable"; }
($formatted = $form{'TITLE'}) =~ s/<[^>]*>//gs;
$form{'TITLE'} = $formatted;
$form{'USERNAME'} =~ s/ /\%20/gm;
print "<CENTER><B><h1>$form{'TITLE'}</B></H1></CENTER><SMALL>Posted: $date<BR>By: $form{'USERNAME'}<BR>Category: $category{$form{'CATEGORY'}}<BR>Location: $locate</SMALL><P><CENTER>$form{'DESC'}<P>";
$image =~ s/ /\%20/gm;
print "[img]http://$image><P[/img]" if ($image);
print "</CENTER>";
print "<p align=center><font face=Verdana size=2><a href=javascript:history.back()>Go Back
and Post It!</a></font></p></body></html>";
exit;
}


sub checkamount {
$count232 = 0;
    foreach $key (sort keys %category) {
$count = 0;
@apple = ();
@apple = split(/,/, $category{$key});
$doit = $apple[1];

open THEFILE, "$basepath/categories/$key.dat";
            (@theitems) = <THEFILE>;
            close THEFILE;
$changeflag = 0;
@listitems = ();
$stopit = ();
foreach $line(@theitems) {
@listitems = split(/\|/, $line);

if ($listitems[5] eq "$form{'USERNAME'}") {

$count232++;
}
}

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


if ($category{$key} =~ m/,/) {
@apple = ();
@apple = split(/,/, $category{$key});
$doit = $apple[0];
$marksub = 1;


shift(@apple);
foreach $item(@apple) {
if (!($item eq "")) {
$item =~ s/ //;
$item =~ s/ /_/gm;
chomp($item);


open THEFILE, "$basepath/categories/$key/$item.dat";
            (@theitems) = <THEFILE>;
            close THEFILE;
$changeflag = 0;
@listitems = ();
$stopit = ();
$count2 = 0;
foreach $line(@theitems) {
@listitems = split(/\|/, $line);
if ($listitems[5] eq "$form{'USERNAME'}") {

$count232++;
}
}
}
}
}
}
#print "$count232 amount of items posted by $form{'USERNAME'}";
#exit;
if ($count232 >= $maxpost) {
&oops('U heeft het maximum aantal advertenties bereikt! Indien u meer advertenties wilt plaatsen neem dan een kijkje bij "informatie" onder het kopje "Dealers en Handelaars".');
}

}



1;

Verwijderd

Heb je dat gekocht? Zonde van het geld.. ;(

Verwijderd

tis idd niet echt mooi gecode, en dan heb ik het nog niet eens over ontbrekende tabjes.... maar volg mijn advies is op, ik ga niet die hele perlcode nachecken, sorry :) maar als je nou is op diverse plekken gewoon het telefoonnr print kun je op die manier achterhalen waar het fout gaat, en dan kun je uiteindelijk 1 of 2 regeltjes hier neer plakken waar de fout inzit

Verwijderd

Topicstarter
Als ik had geweten hoe dat moest Kertje had ik het meteen gedaan maar zoveel verstand heb ik er helaas niet van.

Verwijderd

Op zondag 02 december 2001 15:38 schreef Serveza het volgende:
Als ik had geweten hoe dat moest Kertje had ik het meteen gedaan maar zoveel verstand heb ik er helaas niet van.
ik ben al een behoorlijke tijd uit perl maar volgens mij zo:
print "regel 25: " . $form{'TELEFOONNUMMER'} . "\n";

anyway, zet dat op diverse plekken neer en vul de regelnr neer, zodra je dan ergens het foute nr ziet zie je tussen welke regelnummers het fout is gegaan...

maareh, kun ej de maker van het proggie niet hierover mailen? is gewoon een nederlander...

Verwijderd

Topicstarter
Nee is helaas geen nederlander, ik heb sommige delen zelf vertaald naar het nederlands. Ik heb de maker al gemaild maar die geeft niet thuis, script had ik gekocht bij www.worldwidecreations.com (classifieds).
Pagina: 1