phineas629 has asked for the wisdom of the Perl Monks concerning the following question:
Hello,
I'm new to perl. I apologize as I'm sure I'm breaking some of the rules for posting. I am jumping in head first and hoping to learn from your generosity. My problem is I've been left with a perl script by the programmer and the following directions:"switch from sql server 2005 to sql 2000 to run the perl script."
My question "Is there a better way to work around this without having to change between different versions of servers?" (I assume it is because of the win32 odbc connection being the reason. But I don't know anything.)
############################################# #this program is used to update the pricing # #for the portal websites # # # ############################################# use WIN32::ODBC; use strict; my $Company = $ARGV[0]; chomp $Company; $Company = uc($Company); unless($Company){ print "Usage portal_price.pl [Company code]\n"; print "no Company code entered\n"; die; } my %parts; ########################################### #***enter Company code and BD names here******# ########################################### my %dbs; $dbs{"01"}= "PTL_ABC"; $dbs{"03"}= "PTL_DEF"; $dbs{"04"}= "PTL_GHI"; $dbs{"07"}= "PTL_JKL"; $dbs{"08"}= "PTL_MNO"; $dbs{"10"}= "PTL_PQR"; $dbs{"11"}= "PTL_STU"; $dbs{"12"}= "PTL_VWX"; $dbs{"13"}= "PTL_YZA"; my $uid = "phineas"; my $pwd = "12345"; my $driver = "SQL Server"; #my $server = "111.111.111.111"; my $server = "111.111.111.111"; my $DSN = $dbs{$Company}; my $connection = new Win32::ODBC("Driver=$driver;Database=$DSN;Server= +$server;Trust_Connection=Yes;uid=$uid;pwd=$pwd") || Win32::ODBC::Dump +Error(); ############################ #look up price location # ############################ open(DDD, "< z:\\Companys\\$Company\\data.dir") || die "cannot open da +ta.dir: $!"; my $price_loc; while (my $ddd_line = <DDD>){ chomp $ddd_line; next if ($ddd_line =~m/^%/); next unless ($ddd_line =~m/price/i); $price_loc = $ddd_line; } close(DDD); ############################## #parse the price and store the # #values in the price object # ############################## print "Parsing price.in\n"; open(price, "< $price_loc") || die "cannot open price: $!"; while(my $price_line = <price>){ chomp $price_line; my ($pn, $cost, $msrp) = split(/\|/, $price_line); unless($parts{"$pn"}){ $parts{"$pn"} = eval {price::new price(); } or die ($@); } while($cost){ $cost=~s/^(\w)(\d*)//; $parts{"$pn"}->price::Cost($1, $2); $parts{"$pn"}->price::Ccodes($1); } while($msrp){ $msrp=~s/^(\w)(\d*)//; $parts{"$pn"}->price::Msrp($1, $2); $parts{"$pn"}->price::Mcodes($1); } } print "DONE Parsing price.in\n"; close(price); ################################## #for each part num update the DB # #with new pricing # # # ################################## print "Clearing out D_MSRP field\n"; $connection->Sql("UPDATE pegged SET D_MSRP = ''") && Win32::ODBC::Dump +Error(); print "\nUpdating $DSN with USA pricing\n"; foreach my $key (sort keys %parts){ print "Evaluating $key - "; my $msrp = $parts{"$key"}->price::Msrp("D"); print "Have price $msrp - "; if($msrp){ $connection->Sql("UPDATE pegged SET D_MSRP = '$msrp' WHERE pegged_p +artname = '$key'") && Win32::ODBC::DumpError(); } print "added to SQL DB\n"; } print "Closing DB connection\n"; $connection->Close(); print "Connection closed\n\n"; ########################################## #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@# #@ MODEL CLASS PACKAGE DEFINITION @# #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@# ########################################## package price; use strict; ##################### #CONSTRUCTOR # ##################### sub new{ my ($class) = @_; my $self={ _c_code => undef, _A_cost => undef, _B_cost => undef, _C_cost => undef, _D_cost => undef, _E_cost => undef, _J_cost => undef, _K_cost => undef, _L_cost => undef, _M_cost => undef, _N_cost => undef, _P_cost => undef, _Q_cost => undef, _E_cost => undef, _S_cost => undef, _Y_cost => undef, _Z_cost => undef, _m_code => undef, _A_msrp => undef, _B_msrp => undef, _C_msrp => undef, _D_msrp => undef, _E_msrp => undef, _J_msrp => undef, _K_msrp => undef, _L_msrp => undef, _M_msrp => undef, _N_msrp => undef, _P_msrp => undef, _Q_msrp => undef, _E_msrp => undef, _S_msrp => undef, _Y_msrp => undef, _Z_msrp => undef }; bless $self, ref($class) || $class; return $self; } ########################################## #function to set and return COST # ########################################## sub Cost{ my( $self, $currency, $value) = @_; if($value){ $value = $value / 100; if ($value !~m/\./){ $value .= ".00"; }elsif($value =~m/\.\d$/){ $value .= 0; } $value =~s/^0*//; } $currency = uc($currency); $self->{"_${currency}_cost"} = $value if defined($value); return $self->{"_${currency}_cost"}; } ############################################ #function to set and return the MSRP # ############################################ sub Msrp{ my( $self, $currency, $value) = @_; if($value){ $value = $value / 100; if ($value !~m/\./){ $value .= ".00"; }elsif($value =~m/\.\d$/){ $value .= 0; } $value =~s/^0*//; } $currency = uc($currency); $self->{"_${currency}_msrp"} = $value if defined($value); return $self->{"_${currency}_msrp"}; } ############################################## #function to set and return the used c_codes # ############################################## sub Ccodes{ my( $self, $code) = @_; $code = uc($code); $self->{"_c_code"} .= $code if(defined($code) && $self->{"_c_code"} +!~m/$code/); return $self->{"_c_code"}; } ############################################## #function to set and return the used m_codes # ############################################## sub Mcodes{ my( $self, $code) = @_; $code = uc($code); $self->{"_m_code"} .= $code if(defined($code) && $self->{"_m_code"} +!~m/$code/); return $self->{"_m_code"};
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: perl and switching between different version servers
by marto (Cardinal) on Nov 21, 2012 at 15:53 UTC | |
by phineas629 (Novice) on Dec 05, 2012 at 21:18 UTC | |
by marto (Cardinal) on Dec 05, 2012 at 21:32 UTC | |
by phineas629 (Novice) on Dec 06, 2012 at 19:32 UTC | |
by ig (Vicar) on Jan 24, 2013 at 09:23 UTC |