mIRC code alteration not working as planned - mirc

I've been trying to edit some code I've found for a group of mine, but I've been riddled with some bugs, mainly with the text now showing correctly
on *:start:{
hmake uno 50
if ($isfile(uno.dat)) hload uno uno.dat
}
on *:exit: hsave uno uno.dat
on *:nick:{
var %i = $hget(0), %c
while (%i) {
if ($newnick ison $hget(%i)) {
%c = $v2
break
}
dec %i
}
if ($hget(%c,$nick)) {
hadd %c $newnick $v1
hadd %c $hfind(%c,$nick).data $newnick
}
}
on *:quit:{
var %i = $hget(0), %c
while (%i) {
if ($me ison $hget(%i)) && ($hget($hget(%i),$nick)) remplayer %c $nick $nick has been removed from the current game.
dec %i
}
}
on *:part:#:{
if (!$hget(#)) return
if ($hget(#,$nick)) remplayer # $nick $nick was removed from the current game.
elseif ($nick == $me) hfree #
}
on *:kick:#:{
if (!$hget(#)) return
if ($hget(#,$nick)) remplayer # $nick $nick was removed from the current game.
elseif ($nick == $me) hfree #
}
on $*:text:/^[#!.](uno)?score/Si:#:{
var %u = $iif($2,$2,$nick)
$iif($left($1,1) == #,msg #,notice $nick) %u has $bytes($iif($hget(uno,%u),$v1,0),b) wins.
}
on $*:text:/^[#!.](uno)?top10$/Si:#:{
var %x, %i = $hget(uno,0).item, %o
while (%i) {
%x = $instok(%x,$hget(uno,$hget(uno,%i).item),0,32)
dec %i
}
%x = $sorttok(%x,32,nr)
%i = 1
while (%i <= 10) {
if (!$hget(uno,%i).item) break
%o = $addtok(%o,$ord(%i) $+ : $hfind(uno,$gettok(%x,%i,32),$calc($findtok(%o,$gettok(%x,%i,32),0,32) +1)).data - $bytes($gettok(%x,%i,32),b) |,32)
inc %i
}
$iif($left($1,1) == #,msg #,notice $nick) $left(%o,-1)
}
on $*:text:/^[#!.]uno$/Si:#:{
if ($hget(#,players)) notice $nick There is already a PokéUNO game in progress in # $+ .
else {
if ($hget(#)) hfree #
hmake #
hadd # p1 $nick
hadd # $nick $cards(7)
hinc # players
msg # $nick has started Poké3U04N12O v1.0 by BrAndo and AuroVee. Type !join to join the game.
notice $nick Type !deal to start the game.
}
}
on $*:text:/^[#!.]?join$/Si:#:{
if (!$hget(#,p1)) return
elseif ($hget(#,$nick)) notice $nick You are already playing!
else {
hinc # players
hadd # p $+ $hget(#,players) $nick
hadd # $nick $cards(7)
msg # $nick will be player $hget(#,players) $+ .
}
}
on $*:text:/^[#!.](deal|start( ?game)?|play|begin)$/Si:#:{
if (!$hget(#,p1)) return
elseif (!$hget(#,$nick)) notice $nick You aren't in this game.
elseif ($hget(#,turn)) notice $nick The game has already started.
elseif ($nick != $hget(#,p1)) msg # Only $v2 can start the game.
elseif ($hget(#,players) !> 1) msg # You need atleast two people to play.
else {
var %c = 01
while (01* iswm %c) %c = $cards(1)
hadd # top %c
hadd # turn 1
hadd # rev $true
msg # $hget(#,p1) $+ 's turn.
msg # Top card: $hget(#,top)
notice $nick Your cards: $hget(#,$nick)
}
}
on $*:text:/^[#!.](endgame|uno(stop|end))$/Si:#:{
if (!$hget(#,p1)) return
elseif ($nick != $hget(#,p1)) msg # Only $v2 can end the game.
else {
hfree #
msg # Game ended by $nick $+ .
}
}
on $*:text:/^[#!.]quit$/Si:#:{
if (!$hget(#,p1)) return
elseif (!$hget(#,$nick)) notice $nick You aren't in this game.
else remplayer # $nick $nick has left the game.
}
on $*:text:/^[#!.]kickplayer (.+)$/Si:#:{
if (!$hget(#,p1)) return
elseif ($nick != $hget(#,p1)) msg # Only $v1 can kick people from the game.
elseif (!$hget(#,$regml(1))) msg # $regml(1) is not in this game.
else remplayer # $regml(1) $regml(1) has been kicked from the game by $nick $+ .
}
on $*:text:/^[#!.](show)?(hand|cards?)$/Si:#:{
if (!$hget(#,p1)) return
elseif (!$hget(#,$nick)) notice $nick You aren't in this game.
else notice $nick Your cards: $hget(#,$nick)
}
on $*:text:/^[#!.](uno)?count$/Si:#:{
if (!$hget(#,p1)) return
else {
$iif($left($1,1) == #,msg #,notice $nick) Current score: $regsubex($str(.,$hget(#,players)),/./g,$+($hget(#,p\n),:,$chr(32),$numtok($hget(#,$hget(#,p\n)),32),$chr(32)))
$iif($left($1,1) == #,msg #,notice $nick) Its $hget(#,p $+ $hget(#,turn)) $+ 's turn.
}
}
on $*:text:/^[#!.]topcard$/Si:#:{
if (!$hget(#,p1)) return
msg # Top card: $hget(#,top)
}
on $*:text:/^[#!.]draw ?(card)?$/Si:#:{
if (!$hget(#,p1)) return
elseif (!$hget(#,$nick)) notice $nick You aren't in this game.
elseif ($hget(#,p $+ $hget(#,turn)) != $nick) notice $nick It is not your turn.
else {
var %c = $cards(1)
hadd # $nick $instok($hget(#,$nick),%c,0,32)
notice $nick You drew: %c
hadd # pass $nick
}
}
on $*:text:/^[#!.]pass$/Si:#:{
if (!$hget(#,p1)) return
elseif (!$hget(#,$nick)) notice $nick You aren't in this game.
elseif ($hget(#,p $+ $hget(#,turn)) != $nick) notice $nick It is not your turn.
elseif ($hget(#,pass) != $nick) notice $nick You have to draw once first.
else {
nextturn
var %nnick = $hget(#,p $+ $hget(#,turn))
msg # %nnick $+ 's turn
msg # Top card: $hget(#,top)
notice %nnick Your cards: $hget(#,%nnick)
hdel # pass
}
}
on $*:text:/^[#!.]play/Si:#:{
if (!$hget(#,p1)) return
elseif (!$hget(#,$nick)) notice $nick You aren't in this game.
elseif ($hget(#,p $+ $hget(#,turn)) != $nick) notice $nick It is not your turn.
elseif (!$iscard($2-)) notice $nick Syntax: !play <color> <card> or !play WD4/W <color>
elseif (!$hascard($2-,$nick)) notice $nick You don't have that card.
else {
noop $regex($iscard($2-),/^\x03(\d{2})(\[.+?\])$/)
var %co = $regml(1), %c = $regml(2)
if (%co isin $hget(#,top)) || (%c == $strip($hget(#,top))) || (%c == [*]) {
delcard $nick $2-
hadd # top $iscard($2-)
if (%c == [D2]) {
nextturn
var %snick = $hget(#,p $+ $hget(#,turn)), %nnick, %msg
hadd # %snick $instok($hget(#,%snick),$cards(2),0,32)
nextturn
%nnick = $hget(#,p $+ $hget(#,turn))
if (%co == 12) {
%msg = %snick is hit by Hydro Pump $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
else if (%co == 09) {
%msg = %snick is hit by Seed Flare $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
else if (%co == 08) {
%msg = %snick is hit by Thunder $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
else {
%msg = %snick is hit by Fire Blast $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
}
elseif (%c == [S]) {
nextturn
var %snick = $hget(#,p $+ $hget(#,turn)), %nnick, %msg
nextturn
%nnick = $hget(#,p $+ $hget(#,turn))
%if (%co == 12) {
%msg = %snick is hit by Surf! %nnick $+ 's turn.
}
else if (%co == 09) {
%msg = %snick is hit by Energy Ball! %nnick $+ 's turn.
}
else if (%co == 08) {
%msg = %snick is hit by Thunderbolt! %nnick $+ 's turn.
}
else {
%msg = %snick is hit by Flamethrower! %nnick $+ 's turn.
}
}
elseif (%c == [R]) {
hadd # rev $iif($hget(#,rev),$false,$true)
nextturn
var %nnick = $hget(#,p $+ $hget(#,turn))
if (%co == 08) {
%msg = $nick used Volt Switch! %nnick $+ 's turn.
}
else
{
%msg = $nick used U Turn! %nnick $+ 's turn.
}
}
elseif (%c == [*]) && (4 isin $2-) {
nextturn
var %snick = $hget(#,p $+ $hget(#,turn)), %nnick, %msg
hadd # %snick $instok($hget(#,%snick),$cards(4),0,32)
nextturn
%nnick = $hget(#,p $+ $hget(#,turn))
if (%co == 12) {
%msg = %snick is hit by Hydro Cannon $+ $chr(44) and draws 4! %nnick $+ 's turn.
}
else if (%co == 09) {
%msg = %snick is hit by Frenzy Plant $+ $chr(44) and draws 4! %nnick $+ 's turn.
}
else if (%co == 08) {
%msg = %snick is hit by Bolt Strike $+ $chr(44) and draws 4! %nnick $+ 's turn.
}
else {
%msg = %snick is hit by Blast Burn $+ $chr(44) and draws 4! %nnick $+ 's turn.
} }
elseif (%c == [*]) {
nextturn
var %nnick = $hget(#,p $+ $hget(#,turn))
if (%co == 12) {
%msg = Deck Type is now Water! %nnick $+ 's turn.
}
else if (%co == 09) {
%msg = Deck Type is now Grass! %nnick $+ 's turn.
}
else if (%co == 08) {
%msg = Deck Type is now Electric! %nnick $+ 's turn.
}
else {
%msg = Deck Type is now Fire! %nnick $+ 's turn.
}
}
else {
nextturn
var %nnick = $hget(#,p $+ $hget(#,turn)), %msg = %nnick $+ 's turn.
}
if ($numtok($hget(#,$nick),32) == 1) msg # $nick has 3U04N12O!
elseif (!$v1) {
msg # Congratulations $nick - you won the match!!!
hfree #
hinc uno $nick
return
}
msg # %msg
msg # Top card: $hget(#,top)
notice %nnick Your cards: $hget(#,%nnick)
hdel # pass
}
else notice $nick That card doesn't play.
}
}
alias cards {
var %c = 12[1] 12[2] 12[3] 12[4] 12[5] 12[6] 12[7] 12[8] 12[9] 09[1] 09[2] 09[3] 09[4] 09[5] 09[6] 09[7] 09[8] 09[9] $&
08[1] 08[2] 08[3] 08[4] 08[5] 08[6] 08[7] 08[8] 08[9] 04[1] 04[2] 04[3] 04[4] 04[5] 04[6] 04[7] 04[8] 04[9] 01[WD4] $&
01[WD4] 01[WD4] 01[WD4] 12[D2] 12[D2] 09[D2] 09[D2] 08[D2] 08[D2] 04[D2] 04[D2] 12[S] 12[S] 09[S] 09[S] 08[S] 08[S] $&
04[S] 04[S] 12[R] 12[R] 09[R] 09[R] 08[R] 08[R] 04[R] 04[R] 01[W] 01[W] 01[W] 01[W]
var %i = $1, %o
while (%i) {
%o = $instok(%o,$gettok(%c,$r(1,68),32),0,32)
dec %i
}
return %o
}
alias iscard {
if ($regex($1,/^([bgyr])\w* (\d)$/i)) return $+($col($regml(1)),[,$regml(2),])
elseif ($regex($1,/^w(?:ild)? ?d?(?:raw)? ?4? ([bgyr])/i)) return $col($regml(1)) $+ [*]
elseif ($regex($1,/^([bgyr])\w* d(?:raw)?2$/i)) return $col($regml(1)) $+ [D2]
elseif ($regex($1,/^([bgyr])\w* ([sr])\w*$/i)) return $+($col($regml(1)),[,$upper($regml(2)),])
}
alias col {
if ($1 == b) return 12
elseif ($1 == g) return 09
elseif ($1 == y) return 08
else return 04
}
alias nextturn {
var %c = $iif(#,#,$1)
$iif($hget(%c,rev),hinc,hdec) %c turn
if (!$hget(%c,p $+ $hget(%c,turn))) hadd %c turn $iif($hget(%c,rev),1,$hget(%c,players))
}
alias hascard {
var %c = $iscard($1)
if ($strip(%c) == [*]) {
if (4 isin $1) return $istok($hget(#,$2),01[wd4],32)
else return $istok($hget(#,$2),01[W],32)
}
else return $istok($hget(#,$2),%c,32)
}
alias delcard {
var %c = $iscard($2-), %o
if ($strip(%c) == [*]) %o = $iif(4 isin $2-,01[wd4],01[W])
else %o = %c
hadd # $1 $remtok($hget(#,$1),%o,1,32)
}
alias remplayer {
var %p = $hfind($1,$2).data, %i = $right(%p,-1)
hdel $1 $2
hdel $1 %p
hdec $1 players
msg $1 $3-
if ($hget($1,players) == 1) {
msg $1 Game ended, you need atleast two people to uno.
hfree $1
}
else {
if (!$hget($1,p $+ $hget($1,turn))) {
if (!$hget($1,top)) return
nextturn $1
var %nnick = $hget($1,p $+ $hget($1,turn))
msg $1 %nnick $+ 's turn.
msg $1 Top card: $hget($1,top)
notice %nnick Your cards: $hget($1,%nnick)
}
while (%i <= $hget($1,players)) {
hadd $1 p $+ %i $hget($1,p $+ $calc(%i +1))
hdel $1 p $+ $calc(%i +1)
inc %i
}
}
}
I think I might have already found one of the problems regarding the skip notice not showing, but I'm not so sure about the other statements. What is it which I'm doing wrong here, and how can I correct it so that I can get the statements to show correctly?

It turns out that the %co variable wasn't what I thought it would turn out to be. So what I did was temporally used a msg line at the end of the block where the problem was to figure out what %co came out as, and I noticed that the first two characters determined the color of the card. So, after using $left(%co,2) to get the two characters in %col, all I had to do was to check %col against the four color codes, and post the right info for that line.
I also, as a response to some people complaining about the color of the cards, slightly alter the colors, but I had done that before fully solving the problem of the wrong-showing cards.
Here is the segment of code which I had needed fixed, but is now fully fixed:
on $*:text:/^[~]play/Si:#:{
if (!$hget(#,p1)) return
elseif (!$hget(#,$nick)) notice $nick You aren't in this game.
elseif ($hget(#,p $+ $hget(#,turn)) != $nick) notice $nick It is not your turn.
elseif (!$iscard($2-)) notice $nick Syntax: ~play <color>/<type> <card> or ~play WD4/W <color>/<type>
elseif (!$hascard($2-,$nick)) notice $nick You don't have that card.
else {
noop $regex($iscard($2-),/^\x03(\d{2})(\[.+?\])$/)
var %co = $regml(1), %c = $regml(2)
if (%co isin $hget(#,top)) || (%c == $strip($hget(#,top))) || (%c == [*]) {
delcard $nick $2-
hadd # top $iscard($2-)
var %col = $left(%co,2)
if (%c == [D2]) {
nextturn
var %snick = $hget(#,p $+ $hget(#,turn)), %nnick, %msg
hadd # %snick $instok($hget(#,%snick),$cards(2),0,32)
nextturn
%nnick = $hget(#,p $+ $hget(#,turn))
if (%col == 12) {
%msg = %snick is hit by Hydro Pump $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
else if (%col == 03) {
%msg = %snick is hit by Seed Flare $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
else if (%col == 07) {
%msg = %snick is hit by Thunder $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
else {
%msg = %snick is hit by Fire Blast $+ $chr(44) and draws 2! %nnick $+ 's turn.
}
}
elseif (%c == [S]) {
nextturn
var %snick = $hget(#,p $+ $hget(#,turn)), %nnick, %msg
nextturn
%nnick = $hget(#,p $+ $hget(#,turn))
%msg = %snick is hit by Fake Out! %nnick $+ 's turn.
}
elseif (%c == [R]) {
hadd # rev $iif($hget(#,rev),$false,$true)
var %unick = $hget(#,p $+ $hget(#,turn))
nextturn
var %nnick = $hget(#,p $+ $hget(#,turn))
%msg = %unick used U Turn! %nnick $+ 's turn.
}
elseif (%c == [*]) && (4 isin $2-) {
nextturn
var %snick = $hget(#,p $+ $hget(#,turn)), %nnick, %msg
hadd # %snick $instok($hget(#,%snick),$cards(4),0,32)
nextturn
%nnick = $hget(#,p $+ $hget(#,turn))
%msg = %snick is hit by Judgement $+ $chr(44) and draws 4! %nnick $+ 's turn.
}
elseif (%c == [*]) {
nextturn
var %nnick = $hget(#,p $+ $hget(#,turn))
if (%col == 12) {
%msg = Deck Type is now Water! %nnick $+ 's turn.
}
else if (%col == 03) {
%msg = Deck Type is now Grass! %nnick $+ 's turn.
}
else if (%col == 07) {
%msg = Deck Type is now Electric! %nnick $+ 's turn.
}
else {
%msg = Deck Type is now Fire! %nnick $+ 's turn.
}
}
else {
nextturn
var %nnick = $hget(#,p $+ $hget(#,turn)), %msg = %nnick $+ 's turn.
}
if ($numtok($hget(#,$nick),32) == 1) msg # $nick has 3U04N12O!
elseif (!$v1) {
msg # Congratulations $nick - you won the match!!!
hfree #
hinc uno $nick
return
}
msg # %msg
msg # Top card: $hget(#,top)
notice %nnick Your cards: $hget(#,%nnick)
hdel # pass
}
else notice $nick That card doesn't play.
}
}
alias cards {
var %c = 12[1] 12[2] 12[3] 12[4] 12[5] 12[6] 12[7] 12[8] 12[9] 03[1] 03[2] 03[3] 03[4] 03[5] 03[6] 03[7] 03[8] 03[9] $&
07[1] 07[2] 07[3] 07[4] 07[5] 07[6] 07[7] 07[8] 07[9] 04[1] 04[2] 04[3] 04[4] 04[5] 04[6] 04[7] 04[8] 04[9] 01[WD4] $&
01[WD4] 01[WD4] 01[WD4] 12[D2] 12[D2] 03[D2] 03[D2] 07[D2] 07[D2] 04[D2] 04[D2] 12[S] 12[S] 03[S] 03[S] 07[S] 07[S] $&
04[S] 04[S] 12[R] 12[R] 03[R] 03[R] 07[R] 07[R] 04[R] 04[R] 01[W] 01[W] 01[W] 01[W]
var %i = $1, %o
while (%i) {
%o = $instok(%o,$gettok(%c,$r(1,68),32),0,32)
dec %i
}
return %o
}

Related

mIRC - Pausing hash table

Code;
on *:text:!ticket *:#:{
var %hash $+(ticket.,#)
if $istok(%owner,$nick,32) && $2 == on && !$hget(%hash) {
hmake %hash
msg # Ticket now is open. Use !ticket <point> to join.
}
elseif $2 isnum && $2 > 0 && $hget(%hash) {
var %topic $+(#,.,$nick), %point $readini(points.ini,%topic,points)
if %point >= $2 {
var %p $calc(%point - $2)
writeini points.ini %topic points %p
var %i $hget(%hash,0).item, %t $calc(%i + $2)
while %i < %t { inc %i | hadd %hash %i $nick }
msg # $nick $+ , You bought $2 ticket, you now have %p points
}
else { msg # $nick Sorry, you only have %point points }
}
elseif ($nick isop #) && $2 == roll && $hget(%hash) {
var %i $rand(1,$hget(%hash,0).data)
msg # The winner is $hget(%hash,%i).data $+ .
//I want to pause the raffle here so no more people can buy tickets but it sill keeps the entrys
}
elseif ($nick isop #) && $2 == over && $hget(%hash) {
hfree %hash
}
elseif ($nick isop #) && $2 == go && $hget(%hash) {
//I want people to be allowed to by more tickets and have the old tickets still count
}
}
It's all good. I just need to be able to pause the raffle but not get rid of the entries and then be able to resume the raffle. Comments in code to explain
this is the part you want
on *:text:!ticket *:#:{
var %hash $+(ticket.,#)
if $istok(%owner,$nick,32) && $2 == on && !$hget(%hash) {
hmake %hash
msg # Ticket now is open. Use !ticket <point> to join.
}
elseif $2 isnum && $2 > 0 && $hget(%hash) {
var %topic $+(#,.,$nick), %point $readini(points.ini,%topic,points)
if %point >= $2 && !%pause {
// here script will check if %pause is not set, so script will run normal, if yes, it wont work
var %p $calc(%point - $2)
writeini points.ini %topic points %p
var %i $hget(%hash,0).item, %t $calc(%i + $2)
while %i < %t { inc %i | hadd %hash %i $nick }
msg # $nick $+ , You bought $2 ticket, you now have %p points
}
else { msg # $nick Sorry, you only have %point points }
}
elseif ($nick isop #) && $2 == roll && $hget(%hash) {
var %i $rand(1,$hget(%hash,0).data)
msg # The winner is $hget(%hash,%i).data $+ .
inc -u10 %pause
//10 is time in seconds you can choose whatever time you want, so in this way, no one can buy tickets for 10 seconds
}
elseif ($nick isop #) && $2 == over && $hget(%hash) {
hfree %hash
}
elseif ($nick isop #) && $2 == go && $hget(%hash) {
unset %pause
// if someone typed "roll" and then you want to buy more tickes, typing "go" will just unset %pause
// you can set %pause for more time, or just an unlimmited time
}
}
i didnt test it yet

Raffle price change on input

My Code for mIRC;
on *:text:!raffle *:#:{
var %hash $+(raffle.,#)
if ($nick isop #) && $2 == on && !$hget(%hash) {
hmake %hash
msg # The raffle now is open. Use !raffle and the amount of time you would like to enter to join. Remember, 1 entry = 3 PuroPoints! }
elseif $2 isnum && $2 > 0 && $hget(%hash) {
var %topic $+(#,.,$nick), %point $readini(points.ini,%topic,points)
var %ra $calc( $2 * 3 - 0)
if %point >= %ra {
var %p $calc( %point - %ra )
writeini points.ini %topic points %p
var %i $hget(%hash,0).item, %t $calc(%i + $2)
while %i < %t { inc %i | hadd %hash %i $nick }
msg # $nick $+ , You bought $2 ticket, you now have %p points
}
else { msg # $nick Sorry, you don't have enough PuroPoints }
}
elseif ($nick isop #) && $2 == winner && $hget(%hash) {
var %i $rand(1,$hget(%hash,0).data)
msg # The winner is $hget(%hash,%i).data $+ .
}
elseif ($nick isop #) && $2 == over && $hget(%hash) {
var %i $rand(1,$hget(%hash,0).data)
hfree %hash
}
}
How do I make it so that when !raffle on (number) is put in by a moderator. The number will be the price that a ticket shall cost. At the moment a ticket costs 3.
I thought it would be like;
var %ra $calc( $2 * $3 - 0)
But it won't work>
Any ideas please
Based on your commentes the following should suite you well.
Change:
var %ra $calc( $2 * 3 - 0)
To:
var %ra = $calc($2 * %pricePerTicket)
And write at mIRC command the following:
/set %pricePerTicket 3
This will set the price per ticket to 3, and you can change it at will.

Shipping Handling Charge CGI/Perl

I want to add a flat $25 handling fee for Alaska (AK) and Hawaii (HI) - my test breaks when I add the states and flat fee to the shipping matrix below. Can someone point me in the right direction?
my $totalPounds = sprintf("%.2f",($totalWeight / 16));
#my $shipping = &getShipUPS($totalPounds, $zip, $shipType);
if ($subtotal <= 24.99) {$shipping = '10.95';}
elsif (($subtotal > 24.99) && ($subtotal <= 74.99)) {$shipping = '13.95';}
elsif (($subtotal > 74.99) && ($subtotal <= 149.99)) {$shipping = '14.95';}
elsif ($subtotal >= $150) {$shipping = '18.95';}
elsif ($state eq 'HI','AK') ($subtotal <= 24.99) {$shipping = '10.95'+'25.00';}
elsif ($state eq 'HI','AK') (($subtotal > 24.99) && ($subtotal <= 74.99)) {$shipping = '13.95'+'25.00';}
elsif ($state eq 'HI','AK') (($subtotal > 74.99) && ($subtotal <= 149.99)) {$shipping = '14.95'+'25.00';}
elsif ($state eq 'HI','AK') ($subtotal >= $150) {$shipping = '18.95'+'25.00';}else
$shipping = sprintf("%.2f", $shipping);
my $total = $subtotal + $tax + $shipping;
$subtotal = sprintf("%.2f", $subtotal);
$total = sprintf("%.2f", $total);
You cannot use multiple parameters with eq like this
$state eq 'HI','AK'
You need to do
$state eq 'HI' or $state eq 'AK'
ALso, you cannot put another parenthesis after the first after elsif like this
elsif ($state eq 'HI','AK') ($subtotal >= $150)
You need to do
elsif ( ($state eq 'HI' or $state eq 'AK') or ($subtotal >= $150) )
# ^---- main parantheses -------^
Of course, the smarter choice might be to use a hash
%extra_charges = ( AK => 25,
HI => 25,
# etc
);
...
$subtotal += $extra_charges{$state}; # assuming no missing states
The if-else logic is also all kinds of redundant. This ought to be the equivalent of your code:
if ($subtotal <= 24.99) { $shipping = '10.95' }
elsif ($subtotal <= 74.99) { $shipping = '13.95' }
elsif ($subtotal <= 149.99) { $shipping = '14.95' }
else { $shipping = '18.95' }
if ($state eq 'AK' or $state eq 'HI') { $shipping += 25 }
Those meandering forests of ifs are enough to make one dizzy, and most of them were not required. If a value is not less than or equal to 24.99, it must be bigger than 24.99, so no need to double check that.
That code is a total mess, has multiple syntax errors, and violates DRY.
It would be best to first calculate the basic shipping fee, depending on the subtotal. In a second step you add the $25 charge if the state is Hawaii or Alaska:
my #shipping_fees = (
# max subtotal => fee
[ 24.99 => 10.95 ],
[ 74.99 => 13.95 ],
[ 149.99 => 14.95 ],
[ inf => 18.95 ],
);
my %extra_fees_per_state = (
AK => 25.00,
HI => 25.00,
);
Then:
my $shipping;
for my $shipping_fee (#shipping_fees) {
my ($max, $fee) = #$shipping_fee;
if ($subtotal <= $max) {
$shipping = $fee;
last;
}
}
if (defined( my $extra = $extra_fees_per_state{$state})) {
$shipping += $extra;
}

Add time script Perl

I would like to create a script that will receive 2 paramerters (hours and minutes) ( HH1:MN1 and HH2:MN2)
It has to valid if the #ARGV = 2
Valide if the time provide is correct (hours between 0 to 200 and minutes between 0 to 59)
Add those thow time and print to results
If it is more than 24 hr to print Nbday; HH:Min
if it is more than 7 days it will print Week; nddays; HH:Min.
I started with this but cant figureout how to continue
Any help or idea will be welcomed for the calculation
Thanks
#!/usr/bin/perl
if ($#ARGV != 2)
{
print STDERR "Erreur Parameters have to be 2\n";
exit (-1);
}
if ($ARGV[0] = ~ / ([0-9] | 1 [0-9] ? [0-9] | 200 ) : ( [0-5] ? [0-9] ) /)
{
$heures1 = $1;
$minutes1 = $2;
}
else
{
print STDERR "first parameter invalid\";
exit (-1);
}
if ($ARGV[1] = ~ / ([0-9] | 1 [0-9] ? [0-9] | 200 ) : ( [0-5] ? [0-9] ) /)
{
$heures2 = $3;
$minutes2 = $4;
}
`else `
{
print STDERR "Second parameter invalid\";
exit (-1);
$heures = $heures1 + $heures2;
$minutes = $minutes1 + $minutes2'
The validation code is pretty straightforward:
sub usage {
print STDERR $_[0] if #_;
print STDERR "usage: ...\n";
exit(1);
}
usage() if #ARGV != 2;
my ($hours1, $minutes1) = $ARGV[1] =~ /^([0-9]+):([0-9]+)\z/ or usage();
my ($hours2, $minutes2) = $ARGV[1] =~ /^([0-9]+):([0-9]+)\z/ or usage();
0 <= $hours1 && $hours1 <= 200 or usage("Invalid number of hours for first argument\n");
0 <= $minutes1 && $minutes1 <= 59 or usage("Invalid number of minutes for first argument\n");
0 <= $hours2 && $hours2 <= 200 or usage("Invalid number of hours for second argument\n");
0 <= $minutes2 && $minutes2 <= 59 or usage("Invalid number of minutes for second argument\n");
The range check can be done by regex, but it's error prone and unreadable.
/^0*(0|1[0-9]{0,2}|2(?:00?|[1-9])?|[3-9][0-9]?):0*(0|[1-5][0-9]?|[6-9])\z/
(The regex could be a little simpler, but it's written to virtually eliminate the possibility of backtracking.)
You already asked and we gracefully provided solutions to the math part, so why are you asking again?
my ($hours1, $minutes1) = split /:/, $arg1;
my ($hours2, $minutes2) = split /:/, $arg2;
my $hours = $hours1 + $hours2;
my $minutes = $minutes1 + $minutes2;
$hours += ($minutes - ($minutes % 60)) / 60; $minutes %= 60;
my $days = ($hours - ($hours % 24)) / 24; $hours %= 24;
my $weeks = ($days - ($days % 7)) / 7; $days %= 7;
As for the output part, you should be able to manage on your own. One useful tip:
sprintf('%02d', $minutes) # 0-padded to two digits
#!/usr/bin/perl
die "Erreur Parameters have to be 2" if (scalar(#ARGV) != 2)
if ($ARGV[0] =~ /^([0-9]|1[0-9]?[0-9]|200):([0-5]?[0-9])$/) {
$heures1 = $1;
$minutes1 = $2;
} else {
die "first parameter invalid";
}
if ($ARGV[1] =~ /^([0-9]|1[0-9]?[0-9]|200):([0-5]?[0-9])$/) {
$heures2 = $3;
$minutes2 = $4;
} else {
die "Second parameter invalid";
}
$heures = $heures1 + $heures2;
$minutes = $minutes1 + $minutes2'

Perl: getting all increasing and decreasing Strips in an array (use in Bioinformatics)

I'm new at Perl and im having trouble at designing a certain function in Perl.
The Function should find and return all Increasing and Decreasing Strips.
What does that mean? Two Positions are neighbors if they're neighboring numbers. i.e. (2,3) or (8,7). A Increasing Strip is an increasing Strip of neighbors. i.e. (3,4,5,6). Decreasing Strip is defined similar. At the beginning of every Array a 0 gets added and at the end the length of the array+1. Single Numbers without neighbors are decreasing. 0 and n+1 are increasing.
So if i have the array (0,3,4,5,9,8,6,2,1,7,10) i should get the following results:
Increasing Strips are: (3,4,5) (10) (0)
Decreasing Strips are: (9,8), (6), (2,1) (7)
I tried to reduce the problem to only getting all Decreasing Strips, but this is as far as i get: http://pastebin.com/yStbgNme
Code here:
sub getIncs{
my #$bar = shift;
my %incs;
my $inccount = 0;
my $i=0;
while($i<#bar-1){
for($j=$i; 1; $j++;){
if($bar[$j] == $bar[$j+1]+1){
$incs{$inccount} = ($i,$j);
} else {
$inccount++;
last;
}
}
}
//edit1: I found a Python-Program that contains said function getStrips(), but my python is sporadic at best. http://www.csbio.unc.edu/mcmillan/Media/breakpointReversalSort.txt
//edit2: Every number is exactly one Time in the array So there can be no overlap.
use strict;
my #s = (0,3,4,5,9,8,6,2,1,7,10);
my $i = 0;
my $j = 0; #size of #s
my $inc = "Increasing: ";
my $dec = "Decreasing: ";
# Prepend the beginning with 0, if necessary
if($s[0] != 0 || #s == 0 ) { unshift #s, 0; }
$j = #s;
foreach(#s) {
# Increasing
if( ($s[$i] == 0) || ($i == $j-1) || ($s[$i+1] - $s[$i]) == 1 || ($s[$i] - $s[$i-1] == 1)) {
if($s[$i] - $s[$i-1] != 1) { $inc .= "("; }
$inc .= $s[$i];
if($s[$i+1] - $s[$i] != 1) { $inc .= ")"; }
if($s[$i+1] - $s[$i] == 1) { $inc .= ","; }
}
#Decreasing
if( ($s[$i]-$s[$i-1] != 1) && ($s[$i+1] - $s[$i] != 1) && ($s[$i] != 0) && ($i != $j-1) ) {
if($s[$i-1] - $s[$i] != 1) { $dec .= "("; }
$dec .= $s[$i];
if($s[$i] - $s[$i+1] != 1) { $dec .= ")"; }
if($s[$i] - $s[$i+1] == 1) { $dec .= ","; }
}
$i++;
}
$inc =~ s/\)\(/\),\(/g;
$dec =~ s/\)\(/\),\(/g;
print "$inc\n";
print "$dec\n";
Result:
Increasing: (0),(3,4,5),(10)
Decreasing: (9,8),(6),(2,1),(7)