Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Delete Code Not Working - Perl 4

Status
Not open for further replies.

JennyGW

Technical User
Joined
May 8, 2007
Messages
2
Location
CA
Hi guys.

For some reason my old a/c JennyW isn't working, so here I am...

I have a mailing list that I'm having problems with. However, I used to play around and code with Perl a little bit (around 5 years ago), I basically forgot it all.

What's happening:

- Inside the Admin file for my code. There's a panel where I can view all of the email addresses that I have collected so far.


- Anyway, many people put in bogus address

- There's a button in the Admin panel that deletes any email I select.

- The problem is it's not deleting anything.

- I know I must have touched something in the code...something simple...but I don't know what.

- However, I do know...at least I "think" what the piece of code is that running the problem:


Code:
#########################################################
# use a foreach loop to delete the selected entry files #
#########################################################
&admin_header;
		foreach $entry(@entries) {
				$count=0;
				foreach $list(@list) {

						if ($list =~ /$entry/i) {
   						   splice(@list, $count, 1);

   			 	 		   print "$entry was removed.<br>";
						}
   				 		$count++;
				 }
	
				 
		}
		&back_button;
		&admin_footer;
		
		&flock($listdata.".lock");
		open (list, ">$listdata") or &error("Unable to write to the data file");
		print list @list;
		close(list);
		&unflock($listdata.".lock");
		
		
		exit;
}



Do you guys know what's wrong?


I know this post is HUGE, but if anyone could give me any direction, It'd be appreciated!



Thanks,
Jenny [ponytails2]

 
maybe the piece you are wanting to delete isn't making it to @entries?

Do you get any of the $entry was removed messages when you try and delete something?
 
Add some debugging code to output the contents of both @entries and @list. It is very possible that your making assumptions concerning the format of your data, and therefore you should confirm that things really should be being deleted.

Something like this would work just fine:

Code:
print "entries equals: " . join(', ', map {"'$_'"} @entries) . "<br>";
print "list equals: " . join(', ', map {"'$_'"} @list) . "<br>";

- Miller
 
the code is OK:

Code:
@entries = qw(foo@bar.com bar@foo.com blah@crap.net rats@frogs.org); 
@list = qw(fool@bar.com bars@foo.com blah@crap.net cats@frogs.org); 

foreach $entry(@entries) {
   $count = 0;
   foreach $list(@list) {
      if ($list =~ m/$entry/i) {
         splice (@list, $count, 1);
         print "$entry was removed.\n";
      }
      $count++;
   }
}
print "$_\n" for @list;

output;

Code:
blah@crap.net was removed.
fool@bar.com
bars@foo.com
cats@frogs.org


so the problem is elsewhere.

------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]
 
While it's true that this code is "ok", there are actually two rather obvious bugs in it.

One) $count as the index to @list

After you remove a value from @list, you should not increase the value of $count as you just decreased the @list length at the position of $count.

This bug will manifest anytime there is more than one specific $entry in the list. You will remove the first entry correctly, but the second value removed will be the value after the second $entry.

Two) Using a Regular expression to compare.

Why are you using a regex to compare what are literal strings? Is it just the case insensitive matching? Because there are other ways to accomplish that.

Using a regex does potentially give benefits of ignoring whitespace around values in the @list. However, as you have it implemented right now, it's actually setting you up for a lot of additional bugs. One of those is catching too many items for any entry that is a substring of something in the list. Another is not being able to catch any values in the @list that contain certain regex special characters. The latter bug could be fixed by adding \Q..\E to your regex, but this still leaves you vulnerable to catching too many items.

I would advise you to fix this bug by simply removing the regex compare and using a literal string compare instead.

Code:
[blue]@entries[/blue] = [red]qw([/red][purple]foo@bar.com bar@foo.com blah@crap.net rats@frogs.org[/purple][red])[/red][red];[/red]
[blue]@list[/blue] = [red]qw([/red][purple]fool@bar.com bars@foo.com blah@crap.net cats@frogs.org[/purple][red])[/red][red];[/red]

[olive][b]foreach[/b][/olive] [url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$entry[/blue] [red]([/red][blue]@entries[/blue][red])[/red] [red]{[/red]
	[black][b]my[/b][/black] [blue]$count[/blue] = [fuchsia]0[/fuchsia][red];[/red]
	[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$list[/blue] [red]([/red][blue]@list[/blue][red])[/red] [red]{[/red]
		[olive][b]if[/b][/olive] [red]([/red][url=http://perldoc.perl.org/functions/lc.html][black][b]lc[/b][/black][/url] [blue]$list[/blue] eq [black][b]lc[/b][/black] [blue]$entry[/blue][red])[/red] [red]{[/red]
			[url=http://perldoc.perl.org/functions/splice.html][black][b]splice[/b][/black][/url] [red]([/red][blue]@list[/blue], [blue]$count[/blue], [fuchsia]1[/fuchsia][red])[/red][red];[/red]
			[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple][blue]$entry[/blue] was removed.[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
		[red]}[/red] [olive][b]else[/b][/olive] [red]{[/red]
			[blue]$count[/blue]++[red];[/red]
		[red]}[/red]
	[red]}[/red]
[red]}[/red]
[black][b]print[/b][/black] [red]"[/red][purple][blue]$_[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red] [olive][b]for[/b][/olive] [blue]@list[/blue][red];[/red]

There are a plenty of efficiency improvements that could be made to this code, but this should work just fine.

You still need to check if the values for @entries and @list are what you expect. But the code that I provided in my first post should do this.

- Miller
 
all good points, hopefully JennyGW comes back to read them.

------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]
 
Hey guys.

Thanks very much for the help - but I need more! I'm pretty clueless with this code. When I say I forgot it all - it means I forgot it all!! Eeeeeeek!!

Miller - thank you so much, where in the script would you like me to place this code?

Code:
print "entries equals: " . join(', ', map {"'$_'"} @entries) . "<br>";
print "list equals: " . join(', ', map {"'$_'"} @list) . "<br>";

Where will the output occur and do you want me to post the results - I assume yes lol!


Thanks Kevin and travs69 too!


Jenny
 
under the &admin_header;
and before the foreach line there. I think putting this:
Code:
print "list2 equals: " . join(', ', map {"'$_'"} @list) . "<br>";

between the } and the &back_button;
would help so you can see what list looks like after you think it has been manipulated.
 
Jenny,

It is generally bad practice to include peoples private email addresses in a public tech forum. Spam spiders will eventually pick up those email addresses and start abusing them (more than we are all already abused).

I've quoted your message below, removing all the domain names from the emails. I'm now going to "report" your post, so that preferably it gets deleted since all of the relevant information is contained below. Which I will attempt to answer next.

- Miller

JennyGW said:
Hi.

I'm not sure what to do...

I put in this code:

Code:
print "entries equals: " . join(', ', map {"'$_'"} @entries) . "<br>";
print "list equals: " . join(', ', map {"'$_'"} @list) . "<br>";

I put it where you said to travs69, however, when I selected Delete All Checked Emails, I received this message:

Code:
entries equals: 'fsdf%40asdf.com'
list equals: 'cs2@asdf.com ', 'badsf@asdf.com ', 'themustache@asdf.com ', 'psdsfc66@asdf.com ', 'image@asdf.com ', 'stefan@asdf.com ', 'omnipresent@asdf.com ', 'algorithm13@asdf.com ', 'logan@asdf.com ', 'greg@asdf.com ', 'fsdf@asdf.com '

Any help on where to head from here would be great!


Thanks!
Jenny [ponytail]
 
Yeah Kev, I know. :)

But they never explicitly say, "stop using us as a filler email." So I just assume that they have it setup so that it is no-impact or small impact on them.

Besides the whole point of having that particular domain has to be purely for the amusement factor of all the random emails that you get. And I suppose the bragging rights of, "See how long we've been on da net babes. Boo yah shocka-locka!" [afro2]
 
Anyway ...

Jenny,

You're debugging information told us exactly what was wrong. The @list values do contain spaces after all, and the @entries values are encoded and need to be decoded before used. I've edited your original code to take both of these things into account along with the other bugs that I pointed out.

Code:
[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]@entries[/blue] = [red]([/red][red]'[/red][purple]fsdf%40asdf.com[/purple][red]'[/red][red])[/red][red];[/red]
[black][b]my[/b][/black] [blue]@list[/blue] = [red]([/red][red]'[/red][purple]cs2@asdf.com [/purple][red]'[/red], [red]'[/red][purple]badsf@asdf.com [/purple][red]'[/red], [red]'[/red][purple]themustache@asdf.com [/purple][red]'[/red], [red]'[/red][purple]psdsfc66@asdf.com [/purple][red]'[/red], [red]'[/red][purple]image@asdf.com [/purple][red]'[/red], [red]'[/red][purple]stefan@asdf.com [/purple][red]'[/red], [red]'[/red][purple]omnipresent@asdf.com [/purple][red]'[/red], [red]'[/red][purple]algorithm13@asdf.com [/purple][red]'[/red], [red]'[/red][purple]logan@asdf.com [/purple][red]'[/red], [red]'[/red][purple]greg@asdf.com [/purple][red]'[/red], [red]'[/red][purple]fsdf@asdf.com [/purple][red]'[/red][red])[/red][red];[/red]

[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$entry[/blue] [red]([/red][blue]@entries[/blue][red])[/red] [red]{[/red]
	[blue]$entry[/blue] =~ [red]s{[/red][purple]%([0-9A-F]{2})[/purple][red]}[/red][red]{[/red][purple]chr hex [blue]$1[/blue][/purple][red]}[/red][red]eg[/red][red];[/red] [gray][i]# Remove Encoding[/i][/gray]
	[black][b]my[/b][/black] [blue]$count[/blue] = [fuchsia]0[/fuchsia][red];[/red]
	[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$list[/blue] [red]([/red][blue]@list[/blue][red])[/red] [red]{[/red]
		[olive][b]if[/b][/olive] [red]([/red][blue]$list[/blue] =~ [red]m{[/red][purple]^[purple][b]\s[/b][/purple]*[purple][b]\Q[/b][/purple][blue]$entry[/blue][purple][b]\E[/b][/purple][purple][b]\s[/b][/purple]*$[/purple][red]}[/red][red]i[/red][red])[/red] [red]{[/red]
			[url=http://perldoc.perl.org/functions/splice.html][black][b]splice[/b][/black][/url] [red]([/red][blue]@list[/blue], [blue]$count[/blue], [fuchsia]1[/fuchsia][red])[/red][red];[/red]
			[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple][blue]$entry[/blue] was removed.<br>[/purple][red]"[/red][red];[/red]
		[red]}[/red] [olive][b]else[/b][/olive] [red]{[/red]
			[blue]$count[/blue]++[red];[/red]
		[red]}[/red]
	[red]}[/red]
[red]}[/red]

And the output is:

Code:
fsdf@asdf.com was removed.<br>

Btw Jenny. I understand that you haven't touched perl in 5 years and therefore were not really looking to relearn it. However, just know that typically I'm not in the business of doing people's project for them. No matter how small.

Even a beginning perl programmer would know where to put those debugging print statements. Additionally, once you had the debugging output, it was not hard to diagnose what the problem was, even if you didn't know of a solution.

In the end, I consider most of the time I invested into those thread a waste, so don't expect help like this in the future. Nevertheless, hopefully the above code will serve your needs, regardless of whether or not you take the time to actually understand it.

- Miller
 
my bet is they registered the name years ago as an investment. But now, who the hell wants a domain name that gets the most spam in the known universe?

Or maybe not.... [flush]

------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]
 
Yeah.. pretty good point about not printing peoples email address.. I guess I didn't think about that :)

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top