perl script help

perl script help

Page 1 of 1

2 Replies - 943 Views - Last Post: 12 August 2010 - 10:27 AM

#1 winracer  Icon User is offline

  • D.I.C Head

Reputation: 0
  • View blog
  • Posts: 141
  • Joined: 02-March 09

perl script help

Posted 11 August 2010 - 10:55 AM

I need help on this script.

1st there are two flat data bases main data base( $data_file_path)
other data file($data_file_path_1) If i have one file data in $data_file_path
it adds the data from $data_file_path_1 fine.


but if I have 2 data in $data_file_path it adds the 3rd data and the 2nd data again

hope this makes sence

here is the script please ask any questions and thanks for your help.

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

sub submit_modification1
   {              

$data_file_path_1 = "$path/data/user/$session_username.data";
$location_of_counter_file_1 = "$path/data/user/$session_username.counter";
$location_of_new_counter_file_1 = "$path/data/user/$session_username.counter.tmp";
$location_of_counter_lock_file_1 = "$path/data/user/$session_username.counter.lock";
$location_of_log_file_1 = "$path/data/user/$session_username.log";
$location_of_lock_file_1 = "$path/data/user/$session_username.lock";
$location_of_warn_file_1 = "$path/data/user/$session_username.warn";
$location_of_purge_file_1 = "$path/data/user/$session_username.purge";
$new_data_file_path_1 = "$data_file_path1.tmp";

	# The first thing we must do is make sure that they
		# actually chose a database item to modify.  If they did
		# not, we better warn them and stop processing.

  if ($form_data{'item_to_modify'} eq "")
    {
    &no_item_submitted_for_modification;
    exit;
    }

# Check for valid e-mail address

    if ($form_data{'email'} ne "")
       {
           unless ($form_data{'email'} =~ /.*\@.*\..*/) {
               &email_error;
           }
      }

# Check for valid URL

   if ($form_data{'url'} ne "")
     {
           unless ($form_data{'url'} =~ /http:\/\/.*\..*/) {
               &url_error;
           }
    }

if ($session_group eq "admin") {
  if ((($form_data{'new_user'} ne "") && ($form_data{'new_group'} eq "")) ||

     (($form_data{'new_group'} ne "") && ($form_data{'new_user'} eq ""))) {
&pagesetup;
&admin_error;
&pageclose;
exit;
  }
}

#  open (DATABASE, "$path/db/$category_shortname.db") || &file_open_error
#	("$path/db/$category_shortname.db", "Modify Item",  __FILE__, __LINE__);
#  while (<DATABASE>)
#    {
#    $line = $_; 
#    chop $line;
#    @dbfields = split (/\|/, $line);
#    if ($dbfields[5]) { push (@required_fields, $dbfields[1]); }
#    }
#  close (DATABASE);

foreach $required_field (@required_fields) {
  if ($form_data{$required_field} eq "") {
  &required_error;
  }
}

$usertext = $form_data{'text'};
$usertext =~ s/~nl~/\n/g;
$usertext =~ s/(\W+)/\|/g;
@ad_words = split (/\|/, $usertext);
$number_of_words = @ad_words;

if ($number_of_words > $maxwords) { &word_limit_error; }

for ($i = 1;$i <= 10;$i++) {
@ad_items = &SplitParam($form_data{"dbfield$i"});
$form_data{"dbfield$i"} = "";
foreach $item (@ad_items)
{
$form_data{"dbfield$i"} .= "$item&&";
}
$form_data{"dbfield$i"} =~ s/\&\&$//g;
}



if (!$flock) { &get_file_lock("$location_of_lock_file_1"); }
  open (DATABASE3, "$data_file_path_1") || &file_open_error
	("$data_file_path_1", "Modify item",  __FILE__, __LINE__);   

while (<DATABASE3>)
    {
    $line3 = $_; 
    chop $line3;
    @fields = split (/\|/, $line3);

if (@fields[0] eq $form_data{'item_to_modify'})

{

push(@goodads25,  $line3);
# $new_row = "$line3\n";

}

else{

}
#push @goodads26,  @goodads25;

}
 close (DATABASE3);


if (!$flock) { &get_file_lock("$location_of_lock_file"); }
  open (DATABASE, "$data_file_path") || &file_open_error
	("$data_file_path", "Modify item",  __FILE__, __LINE__);
if ($flock) { flock DATABASE, 2; }
  open (NEW_DATABASE, ">>$new_data_file_path") || &file_open_error
	("$new_data_file_path", "Modify item",  __FILE__, __LINE__);

  while (<DATABASE>)
    {
    $line = $_; 
    chop $line;
    @fields = split (/\|/, $line);


if ($fields[$index_of_db_id] ne $form_data{'item_to_modify'})
      {

print NEW_DATABASE "$line\n"; 
print NEW_DATABASE "@goodads25\n";
     }

    else #if ($fields[$index_of_db_id] eq $form_data{'item_to_modify'})
      {
    # $old_row = "$line\n";

	if (($session_username eq $fields[$index_of_who_modified]) || ($session_group eq "admin"))
	{

	$when_modified = $fields[$index_of_modification_time];
      $who_modified = $session_username;

      $user_modify = $fields[$index_of_who_modified];
      $email_modify = $fields[$index_of_email];
      $url_modify = $fields[$index_of_url];
	$db_id_modify = $fields[$index_of_db_id];
	$status = $fields[$index_of_status];

      if ($session_group eq "admin")
        {
           if ($form_data{'new_group'} ne "")
             {
         $group = $form_data{'new_group'};
              }
           else
              {
        $group = $fields[$index_of_group_modified];
              }
        }
      else
       {
       $group = $fields[$index_of_group_modified];
       }

      if ($session_group eq "admin")
       {
           if ($form_data{'new_user'} ne "")
             {
               $who_modified = $form_data{'new_user'};
              }
          else
             {
                $who_modified = $fields[$index_of_who_modified];
              }
         }

if (($require_admin_approval eq "on") && ($session_group eq "admin")) { $new_status = "ok"; }
else { $new_status = "$fields[$index_of_status]"; }

if ($form_data{'renew_ad'} eq "on") {

if ((($limit_renewals eq "on") && ($fields[$index_of_times_renewed] < $max_renewals)) || ($limit_renewals ne "on")) {
$ad_renewed = "on";
$new_renewals = $fields[$index_of_times_renewed] + 1;
$original_ad_duration = $fields[$index_of_ad_duration] / $new_renewals;
$new_ad_duration = $fields[$index_of_ad_duration] + $original_ad_duration;
  }
else {
$new_renewals = $fields[$index_of_times_renewed];
$new_ad_duration = $fields[$index_of_ad_duration];
  }
}

else {
$new_renewals = $fields[$index_of_times_renewed];
$new_ad_duration = $fields[$index_of_ad_duration];
  }

    $new_row = "$fields[$index_of_db_id]|$who_modified|$group|$fields[$index_of_modification_time]|$new_status|$new_ad_duration|$new_renewals|||||$form_data{'name'}|$form_data{'street'}|$form_data{'city'}|$form_data{'state'}|$form_data{'zip'}|$form_data{'country'}|$form_data{'phone'}|$form_data{'display_address'}|$form_data{'email'}|$form_data{'url'}|$fields[$index_of_category]|$fields[$index_of_subcategory]|$form_data{'caption_header'}|$form_data{'caption'}|$form_data{'text'}|$form_data{'dbfield1'}|$form_data{'dbfield2'}|$form_data{'dbfield3'}|$form_data{'dbfield4'}|$form_data{'dbfield5'}|$form_data{'dbfield6'}|$form_data{'dbfield7'}|$form_data{'dbfield8'}|$form_data{'dbfield9'}|$form_data{'dbfield10'}";

	$new_row =~ s/([\0-\37\177])/ /g;
	$new_row =~ s/\r\n/ /g;

#print NEW_DATABASE "$new_row\n";

$successful_modification = "on";

	  } # end of if admin or correct user

else {
#print NEW_DATABASE "$old_row\n";
}

      } # End of  else
    } # End of while (<DATABASE>)

  close (NEW_DATABASE);



if ($flock) { rename($new_data_file_path, $data_file_path); }
  close (DATABASE);


if (!$flock) { 
unlink("$data_file_path");
rename($new_data_file_path, $data_file_path); }

if ($os eq "unix") { chmod 0666, "$data_file_path"; }

if (!$flock) { &release_file_lock("$location_of_lock_file"); }

if ($successful_modification) {

if ($uselogs) {
  open (LOG_FILE, ">>$location_of_log_file") || die "can't open log file\n";
  print LOG_FILE "MODIFY\|$ENV{'REMOTE_ADDR'}\|$new_row";
  print LOG_FILE "MODIFY_OLD\|$old_row\n";  
  close (LOG_FILE);

if ($os eq "unix") { chmod 0666, "$location_of_log_file"; }

  }


  open (DATABASE, "$category_file_path") || &file_open_error
	("$category_file_path", "Submit Modification",  __FILE__, __LINE__);
  while (<DATABASE>)
    {
    $line = $_; 
    chop $line;
    @categoryfields = split (/\|/, $line);
if ($fields[$index_of_category] eq $categoryfields[1]) {
if ($categoryfields[5] > 0) {
$unformatted_total_cost = $categoryfields[5];
$total_cost = sprintf ("%.2f", $unformatted_total_cost);
	}
last;
     }
    }
  close (DATABASE);


if (($total_cost > 0) && ($ad_renewed eq "on")) {
if (!$flock) { &get_file_lock("$location_of_payments_counter_lock_file"); }
  open (COUNTER_FILE, "$location_of_payments_counter_file") || 
	&file_open_error ("$location_of_payments_counter_file", "Submit Modification",
	__FILE__, __LINE__);
if ($flock) { flock COUNTER_FILE, 2; }
  open (NEW_COUNTER_FILE, ">$location_of_new_payments_counter_file") || 
	&file_open_error ("$location_of_new_payments_counter_file", "Submit Modification",
	__FILE__, __LINE__);

  while (<COUNTER_FILE>)
    {
    $line = $_; 
    chomp $line;
    $current_counter = $line;
  $current_counter++;
  $new_payments_counter = $current_counter;
  print NEW_COUNTER_FILE "$new_payments_counter";
  }
  close (NEW_COUNTER_FILE);
if ($flock) { rename($location_of_new_payments_counter_file, $location_of_payments_counter_file); }
  close (COUNTER_FILE);
if (!$flock) { 
unlink("$location_of_payments_counter_file");
rename($location_of_new_payments_counter_file, $location_of_payments_counter_file); }
if ($os eq "unix") { chmod 0666, "$location_of_payments_counter_file"; }
if (!$flock) { &release_file_lock("$location_of_payments_counter_lock_file"); }

($dbmonth,$dbday,$dbyear) = split (/\//, $current_date);
$julian_day = &jday($dbmonth,$dbday,$dbyear);
$expiration_day = $julian_day + $mail_payment_days;
($expmonth,$expday,$expyear,$expweekday) = &jdate($expiration_day);
  if ($expmonth < 10) { $expmonth = "0$expmonth"; }
  if ($expday < 10) { $expday = "0$expday"; }
$duedate = "$expmonth/$expday/$expyear";

    $new_payments_row = "$new_payments_counter|$who_modified|$group||||renewal|$fields[$index_of_db_id]|$total_cost|$current_date|$duedate||||||||||||||||||||||||\n";

if (!$flock) { &get_file_lock("$location_of_payments_lock_file"); }
  open (DATABASE, ">>$payments_data_path") || 
	&file_open_error ("$payments_data_path", "Submit Addition",
	__FILE__, __LINE__);
if ($flock) { flock DATABASE, 2; }
  print DATABASE $new_payments_row;
  close (DATABASE);
if ($os eq "unix") { chmod 0666, "$payments_data_path"; }
if (!$flock) { &release_file_lock("$location_of_payments_lock_file"); }

}



if ($notify_modify eq "on")
	{
&require_supporting_libraries (__FILE__, __LINE__, "$path/html/mail.pl");
&modify_email_message;

if ($require_admin_from_address) { $from = $master_admin_email_address; }
else { $from = $email_modify; }

&send_mail($from, $master_admin_email_address, $subject, $message);

    }


if (($total_cost > 0) && ($ad_renewed eq "on"))
  {
&require_supporting_libraries (__FILE__, __LINE__, "$path/html/mail.pl");
&renew_response_email_message;
&send_mail($master_admin_email_address, $email_modify, $subject, $message);
}

&require_supporting_libraries (__FILE__, __LINE__, "$path/html/successful_modification_message.pl");
    &successful_modification_message;
}

else {
#&unsuccessful_modification_message;
&submit_modification;
}

  }             
#############################################################
1;





This post has been edited by winracer: 11 August 2010 - 12:44 PM


Is This A Good Question/Topic? 0
  • +

Replies To: perl script help

#2 dsherohman  Icon User is offline

  • Perl Parson
  • member icon

Reputation: 226
  • View blog
  • Posts: 654
  • Joined: 29-March 09

Re: perl script help

Posted 12 August 2010 - 10:08 AM

How many repetitions of the duplicated data do you get? If there are 4 files, does one of them get processed once, one twice, one three times, and the last four times? If so, I'd take a close look at your loops to make sure they have the right start/end conditions so they don't loop over the same file more than once and, if you're using any arrays to hold sets of 'things to do', take a close look at them, too, to be sure that items are being removed after the first time they're processed.

If you review those things and don't find the problem, you'll need to narrow down the location of the issue to a smaller section of code and give us just that piece to look at. 350 lines is a bit much for someone unfamiliar with the project and what it does to take in all at once, especially when it's indented inconsistently and we're not able to run it for ourselves.


Some other general points of style and best practice:

- All of your variables are global and there is a strong possibility that this may be the cause of your current problem, as it allows code in one section of the program/module to overwrite values from another section. Using the "my" keyword to restrict variable lifetime to the narrowest possible scope can help to avoid this; adding "use strict;" at the start of the file will tell perl to require you to properly declare all variables if you need help remembering.

- The "&func" syntax is a relic of Perl 4 and has side-effects which are not what you intend. Just use "func" or "func()". Do not prefix user-defined function calls with an &.

- You can use alternate regex delimiters instead of /, which can clean up regexes processing URLs quite a bit:
unless ($form_data{'url'} =~ m[http://.*\..*]) {


Also, is the exclusion of https URLs intentional? Personally, I'd use
unless ($form_data{'url'} =~ m[https?://>/.*\..*]) {


- The use of global file handles and the two-argument form of "open" are highly discouraged. It is much better to use lexical file handles (globals have problems as mentioned above) and three-argument open (it's more secure when dealing with user-provided data). So, instead of
open (DATABASE3, "$data_file_path_1") || &file_open_error
use
open (my $database3, '<', $data_file_path_1) || file_open_error


Incidentally, naming the filehandles "DATABASE" can be mildly confusing... On my first scan of the code, I was almost to the end before it registered on me that DATABASE3 was a text file, not an actual (SQL) database.

- You don't need to put quotes around variable names to use them.
get_file_lock("$location_of_lock_file_1")
and
get_file_lock($location_of_lock_file_1)
are exactly equivalent. (This is done inconsistently throughout the code, apparently due to two different authors; I just mention it in case you're the one who is using the unnecessary quotes. Ignore this point if you're the one who isn't using them.)
Was This Post Helpful? 1
  • +
  • -

#3 winracer  Icon User is offline

  • D.I.C Head

Reputation: 0
  • View blog
  • Posts: 141
  • Joined: 02-March 09

Re: perl script help

Posted 12 August 2010 - 10:27 AM

thanks dsherohman


I will look at these things and will post back what I find or need more help.

they are two flat database text files. to make a long story short I have one txt file with the data that is displayed on my site. the 2nd txt file is for old data that is not displayed what I am trying to do is if some one want to display the old data this script will let them.

I think the error is in the code below, but can't find it

if (!$flock) { &get_file_lock("$location_of_lock_file_1"); }  

094   open (DATABASE3, "$data_file_path_1") || &file_open_error  

095     ("$data_file_path_1", "Modify item",  __FILE__, __LINE__);     

096    

097 while (<DATABASE3>)  

098     {  

099     $line3 = $_;   

100     chop $line3;  

101     @fields = split (/\|/, $line3);  

102    

103 if (@fields[0] eq $form_data{'item_to_modify'})  

104    

105 {  

106    

107 push(@goodads25,  $line3);  

108 # $new_row = "$line3\n";  

109    

110 }  

111    

112 else{  

113    

114 }  

115 #push @goodads26,  @goodads25;  

116    

117 }  

118  close (DATABASE3);  

119    

120    

121 if (!$flock) { &get_file_lock("$location_of_lock_file"); }  

122   open (DATABASE, "$data_file_path") || &file_open_error  

123     ("$data_file_path", "Modify item",  __FILE__, __LINE__);  

124 if ($flock) { flock DATABASE, 2; }  

125   open (NEW_DATABASE, ">>$new_data_file_path") || &file_open_error  

126     ("$new_data_file_path", "Modify item",  __FILE__, __LINE__);  

127    

128   while (<DATABASE>)  

129     {  

130     $line = $_;   

131     chop $line;  

132     @fields = split (/\|/, $line);  

133    

134    

135 if ($fields[$index_of_db_id] ne $form_data{'item_to_modify'})  

136       {  

137    

138 print NEW_DATABASE "$line\n";   

139 print NEW_DATABASE "@goodads25\n";  

140      }  

141    

142     else #if ($fields[$index_of_db_id] eq $form_data{'item_to_modify'})  

143       {  

144     # $old_row = "$line\n";  



This post has been edited by winracer: 12 August 2010 - 10:29 AM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1