Из PERL в PHP

bovkun · 29 Авг 2003

Из PERL в PHP

Народ, подскажите, возможно ли малой кровью перевести скрипт, который был написан на Перле в PHP ?

Столкнулся с необходимостью всунуть на сайт Перловский скрипт, который действительно важен, а как его переделать под сви нужды я не пойму. Вот если бы он был на PHP, который мне в достаточной для меня мере понятен, было бы супер!

Может ли кто переделать скрипт или пояснить как вообще быть в в такой ситуации?....

Вот эта хрень :confused:

PHP:

#!/usr/local/bin/perl
use strict;
use CGI;
use Net::SMTP;
use MIME::Base64;

#some 'constant' declarations

my $F_Label_Prefix = 'field_label_';
my $F_Required_Prefix = 'field_required_';
my $F_MaxLength_Prefix = 'field_maxlength_';
my $F_Type_Prefix = 'field_type_';
my $F_Name_Prefix = 'field_name_';
my $F_Data_Prefix = 'field_data_';

my $R_Prefix = 'rule_';
my $R_Field_Suffix = '_field';
my $R_Email_Suffix = '_email';
my $E_Prefix = 'email_';

#main code

my $q = new CGI;

my $SuccessText = $q->param( 'successtext' );
$SuccessText = decode_base64( $SuccessText );
my $FailHeader = $q->param( 'failheader' );
$FailHeader = decode_base64( $FailHeader );
my $FailFooter = $q->param( 'failfooter' );
$FailFooter = decode_base64( $FailFooter );

#load fields

my %Fields;
my @names = $q->param;
my $UserEmail;
my $ErrorOccured = 0;
my $ErrorMessage = "<BR>";

FIELD: foreach my $name (@names)
{
	my $labelPrefix = substr $name, 0, length $F_Label_Prefix;
	
	if ( $labelPrefix eq $F_Label_Prefix )
	{
		my $odbcName = substr $name, length $F_Label_Prefix;
		
		my $sParm = $F_Required_Prefix . $odbcName;
		
		my $Required = $q->param( $sParm );
		
		$sParm = $F_Type_Prefix . $odbcName;
		
		my $Type = $q->param( $sParm );
		
		$sParm = $F_MaxLength_Prefix . $odbcName;
		
		my $MaxLength = $q->param( $sParm );
		
		$sParm = $F_Name_Prefix . $odbcName;
		
		my $FName = $q->param( $sParm );
		
		$sParm = $F_Label_Prefix . $odbcName;
		
		my $Label = $q->param( $sParm );
		
		$sParm = $F_Data_Prefix . $odbcName;
		
		my @Data = $q->param( $sParm );
		
		if ( $Required && !$Data[0] )
		{
			$ErrorMessage .= $Label;
			$ErrorMessage .= " is a required field.";
			$ErrorMessage .= $q->br();
			$ErrorOccured = 1;
			last FIELD;
		}
		
		if ( $FName eq 'E-mail Address' )
		{
			$UserEmail = $Data[0];
		}
		
		my %FieldRec;
		
		$FieldRec{'label'} = $Label;
		$FieldRec{'name'} = $FName;
		$FieldRec{'type'} = $Type;
		$FieldRec{'maxlength'} = $MaxLength;
		$FieldRec{'required'} = $Required;
		$FieldRec{'value'} = \@Data;
		
		$Fields{$odbcName} = \%FieldRec;
	}
}

if ( !$ErrorOccured )
{
	my $smtpserver = $q->param( 'smtpserver' );
	my $default_email = $q->param( 'default_email' );
	my $from_email = $q->param( 'from_email' );
	my $uses_rules = $q->param('uses_rules');
	
	my @Emails;
	
	my $nCount = @names;
	
	if ( $uses_rules )
	{
		my $idx = 0;
		RULES: while ( $idx < $nCount )
		{
			my $RuleIdf = $R_Prefix . $idx;
			
			my $Rule = $q->param( $RuleIdf );
			
			$RuleIdf = $R_Prefix . $idx . $R_Field_Suffix;
			
			my $odbcName = $q->param( $RuleIdf );
			
			last RULES unless ($Rule || $odbcName );
			
			$RuleIdf = $R_Prefix . $idx . $R_Email_Suffix;
			
			my $Email = $q->param( $RuleIdf );
			
			my $Field = $Fields{$odbcName};
			
			redo RULES unless $Field;
			
			$idx++;
			
			my $fieldVal = uc $Field->{'value'}->[0];
			my $ruleVal = uc $Rule;
			
			if ( $fieldVal eq $ruleVal )
			{
				if ( $Email =~ /\;/ )
				{
					push @Emails, split(/;/,$Email);
				}
				else
				{
					push @Emails, $Email;
				}
				last RULES;
			}
		}
		
		if ( !@Emails )
		{
			push @Emails, $default_email;
		}
	}
	else
	{
		my $idx = 0;
		EMAILS: while ( $idx < $nCount )
		{
			my $sParm = $E_Prefix . $idx;
			
			my $Email = $q->param( $sParm );
			
			last EMAILS unless $Email;
			
			push @Emails, $Email;
			
			$idx++;
		}
	}
	
	my $mtifile = '"MTI: Web Inquiry"' . "\015\012";
	$mtifile .= '"BUSINESS_PEOPLE","1","401","E-mail Address"' . "\015\012";
	
	my $mtiField = '"IDV_FIRM",';
	my $mtiType = '"ALPHA-1",';
	my $mtiValue = '"1",';
	
	my @fkeys = sort keys %Fields;
	
	foreach my $FieldKey ( @fkeys )
	{
		my $odbcName = $FieldKey;
		
		my $sName =$Fields{$FieldKey}->{'name'};
		
		if ( substr($odbcName,0,2) eq 'U_' )
		{
			$sName = "P_" . $sName;
		}
		else
		{
			$sName = uc $sName;
		}
		
		if ( $sName eq 'NAME' )
		{
			$sName = 'LAST_NAME';
		}
	
		if ( $sName eq 'COMPANY' )
		{
			$sName = 'COMPANYORGANIZATION';
		}
	
		if ( $sName eq 'STATE_PROVINCE' )
		{
			$sName = 'STATEPROVINCE';
		}
		
		if ( $sName eq 'STATE PROVINCE' )
		{
			$sName = 'STATEPROVINCE';
		}
	
		if ( $sName eq 'ZIP_CODE' )
		{
			$sName = 'ZIPPOSTAL_CODE';
		}
		
		if ( $sName eq 'ZIP CODE' )
		{
			$sName = 'ZIPPOSTAL_CODE';
		}
	
		$mtiField .= '"';
		$mtiField .=$sName;
		$mtiField .= '",';
		
		$mtiType .= '"';
	
		SWITCH: for ($Fields{$FieldKey}->{'type'})
		{
			/0/	&&	do { $mtiType .= 'TABLE-29'; last;};
			/1/	&&	do { $mtiType .= 'DATE-2'; last;};
			/2/	&&	do { $mtiType .= 'NUMERIC-'; $mtiType .= $Fields{$FieldKey}->{'maxlength'};  last;};
	#		/3/	&&	do { }
			$mtiType .= 'ALPHA-';
			$mtiType .= $Fields{$FieldKey}->{'maxlength'};
			last;
		}
		
		$mtiType .= '",';
		
		my $tmp;
		
		if ( @{$Fields{$FieldKey}->{'value'}} > 1 )
		{
			foreach my $val ( @{$Fields{$FieldKey}->{'value'}} )
			{
				$tmp .= $val;
				$tmp .= ';';
			}
			$tmp =~ s/\;\z//;
		}
		else
		{
			$tmp = $Fields{$FieldKey}->{'value'}->[0];
		}
		$tmp =~ s/\"/\'/;
		
		$mtiValue .= '"';
		$mtiValue .= $tmp;
		$mtiValue .= '",';
	}
	
	$mtiField =~ s/\,\z//;
	$mtiType =~ s/\,\z//;
	$mtiValue =~ s/\,\z//;
	
	$mtifile .= $mtiField . "\015\012";
	$mtifile .= $mtiType . "\015\012";
	$mtifile .= $mtiValue;
	
	$mtifile = encode_base64( $mtifile );
	
	my $smtp = Net::SMTP->new( $smtpserver, Timeout => 30 );

	foreach my $EmailRecipient ( @Emails )
	{
		$smtp->mail( $from_email );
		$smtp->to( $EmailRecipient, SkipBad => 1 );
		
		#~ $smtp->reset();
		
		$smtp->data();
		$smtp->datasend('To: ');
		$smtp->datasend( $EmailRecipient );
		$smtp->datasend("\n");
		$smtp->datasend("Subject: Web Inquiry\n");
		$smtp->datasend("MIME-Version: 1.0\n");
		$smtp->datasend('Content-Type: multipart/mixed; boundary="--=_NextPart_000_0018_01C0EA94.CF948390"' . "\n");
		$smtp->datasend("\n");
		$smtp->datasend("\n");
		$smtp->datasend("This is a multi-part message in MIME format.\n");
		$smtp->datasend("\n");
		$smtp->datasend("----=_NextPart_000_0018_01C0EA94.CF948390\n");
		$smtp->datasend("Content-Type: text/plain\n");
		$smtp->datasend("Content-Transfer-Encoding: 7bit\n");
		$smtp->datasend("\n");
		$smtp->datasend("Open the MTI attachment to import it into Maximizer.\n");
		$smtp->datasend("\n");
		$smtp->datasend("----=_NextPart_000_0018_01C0EA94.CF948390\n");
		$smtp->datasend('Content-Type: application/octet-stream; name="webinq.mti"' . "\n");
		$smtp->datasend("Content-Transfer-Encoding: base64\n");
		$smtp->datasend("Content-Disposition: attachment; filename=webinq.mti\n");
		$smtp->datasend("\n");
		$smtp->datasend( $mtifile );
		$smtp->datasend("\n");
		$smtp->datasend("\n");
		$smtp->datasend("----=_NextPart_000_0018_01C0EA94.CF948390--\n");
		$smtp->dataend();
		
		$smtp->quit;
		$smtp = Net::SMTP->new( $smtpserver, Timeout => 30 );
	}
	
	print $SuccessText;
}
else
{
	print $FailHeader;
	print $ErrorMessage;
	print $FailFooter;
}

Есть готовность заплатить (в разумных пределах, конечно).

P.S. Я в Киеве.

bovkun · 5 Сен 2003

Есть готовность заплатить (в разумных пределах, конечно).

Mr.Ak · 5 Сен 2003

сча в корзину уйдет, правда?

bovkun · 5 Сен 2003

Похоже на то ... :-/

Altex · 6 Сен 2003

А зачем тебе его на РНР переделывать?
Если не умеешь - не берись

Работает - и пусть работает, появится время - сам разбирёшься (по себе сужу). Неужели твой хостер не поддерживает перл?

Bloody · 10 Сен 2003

Каким образом переделать? (Что он должен делать?)

young · 10 Сен 2003

Я могу
Предложения по оплате на [email protected]

Из PERL в PHP

bovkun

Новичок

bovkun

Новичок

Mr.Ak

Guest

bovkun

Новичок

Altex

Новичок

Bloody

Guest

young

Новичок