C-Zar.pl ;)

[mtbs]

Mi tez sie nudzilo(a raczej wreszcie mialem chwile czasu! ) i z tej okazji aby sprawdzic w praktyce pierwsze trzy czesci kursu perl'a postanowilem skrobnac program ktory koduje i odkodowuje szyfr cezara - tak wiem banal...(ale mysle ze do cwiczenia w sam raz, zwlaszcza dla poczatkujacych). A moze jakiemus studentowi sie przyda? Ponizej zamieszczam kod, bardzo prosze o sprawdzenie ew. bledow i opierdzielenie() albo pochwale(). Pod kodem jest pare pytanek.

###########################
#			  #
#    Program C-Zar.pl     #
#        by mtbs!	  #
#			  #
#Odpal np.C:\perl\C-Zar.pl#
# aby dostac pelna liste  #
#        funkcji	  #
# Pozdrawiam TQM, czekam  #
# na trzecia czesc kursu! #
#			  #
###########################

use strict;
use warnings;

sub szyfruj {
if ($ARGV[1]==1) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/bcdefghijklmnoprstuwxyza/;
	print "$ARGV[0]";}

if ($ARGV[1]==2) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/cdefghijklmnoprstuwxyzab/;
	print "$ARGV[0]";}

if ($ARGV[1]==3) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/defghijklmnoprstuwxyzabc/;
	print "$ARGV[0]";}

if ($ARGV[1]==4) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/efghijklmnoprstuwxyzabcd/;
	print "$ARGV[0]";}

if ($ARGV[1]==5) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/fghijklmnoprstuwxyzabcde/;
	print "$ARGV[1]";}

if ($ARGV[1]==6) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/ghijklmnoprstuwxyzabcdef/;
	print "$ARGV[0]";}

if ($ARGV[1]==7) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/hijklmnoprstuwxyzabcdefg/;
	print "$ARGV[0]";}

if ($ARGV[1]==8) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/ijklmnoprstuwxyzabcdefgh/;
	print "$ARGV[1]";}

if ($ARGV[1]==9) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/jklmnoprstuwxyzabcdefghi/;
	print "$ARGV[0]";}

if ($ARGV[1]==10) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/klmnoprstuwxyzabcdefghij/;
	print "$ARGV[0]";}

if ($ARGV[1]==11) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/lmnoprstuwxyzabcdefghijk/;
	print "$ARGV[0]";}

if ($ARGV[1]==12) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/mnoprstuwxyzabcdefghijkl/;
	print "$ARGV[0]";}

if ($ARGV[1]==13) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/noprstuwxyzabcdefghijklm/;
	print "$ARGV[0]";}

if ($ARGV[1]==14) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/oprstuwxyzabcdefghijklmn/;
	print "$ARGV[0]";}

if ($ARGV[1]==15) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/prstuwxyzabcdefghijklmno/;
	print "$ARGV[0]";}

if ($ARGV[1]==16) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/rstuwxyzabcdefghijklmnop/;
	print "$ARGV[0]";}

if ($ARGV[1]==17) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/stuwxyzabcdefghijklmnope/;
	print "$ARGV[0]";}

if ($ARGV[1]==18) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/tuwxyzabcdefghijklmnoper/;
	print "$ARGV[0]";}

if ($ARGV[1]==19) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/uwxyzabcdefghijklmnopers/;
	print "$ARGV[0]";}

if ($ARGV[1]==20) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/wxyzabcdefghijklmnoperst/;
	print "$ARGV[0]";}

if ($ARGV[1]==21) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/xyzabcdefghijklmnoperstu/;
	print "$ARGV[0]";}

if ($ARGV[1]==22) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/yzabcdefghijklmnoperstuw/;
	print "$ARGV[0]";}

if ($ARGV[1]==23) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/zabcdefghijklmnoperstuwx/;
	print "$ARGV[0]";}

if ($ARGV[1]==24) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/abcdefghijklmnoperstuwxyz/;
	print "Pelne przesuniecie - tekst nie zmienil sie!\r\n";
	print "$ARGV[0]";}

if (int($ARGV[1])>24) {die "\nNiepoprawny argument drugi!\r\nArgument drugi musi byc liczba z przedzialu 1-24\n";
	}
 }

sub odszyfruj {
if ($ARGV[1]==1) {$ARGV[0]=~ tr/bcdefghijklmnoprstuwxyza/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==2) {$ARGV[0]=~ tr/cdefghijklmnoprstuwxyzab/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==3) {$ARGV[0]=~ tr/defghijklmnoprstuwxyzabc/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==4) {$ARGV[0]=~ tr/efghijklmnoprstuwxyzabcd/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==5) {$ARGV[0]=~ tr/fghijklmnoprstuwxyzabcde/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==6) {$ARGV[0]=~ tr/ghijklmnoprstuwxyzabcdef/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==7) {$ARGV[0]=~ tr/hijklmnoprstuwxyzabcdefg/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==8) {$ARGV[0]=~ tr/ijklmnoprstuwxyzabcdefgh/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==9) {$ARGV[0]=~ tr/jklmnoprstuwxyzabcdefghi/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==10) {$ARGV[0]=~ tr/klmnoprstuwxyzabcdefghij/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==11) {$ARGV[0]=~ tr/lmnoprstuwxyzabcdefghijk/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==12) {$ARGV[0]=~ tr/mnoprstuwxyzabcdefghijkl/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==13) {$ARGV[0]=~ tr/noprstuwxyzabcdefghijklm/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==14) {$ARGV[0]=~ tr/oprstuwxyzabcdefghijklmn/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==15) {$ARGV[0]=~ tr/prstuwxyzabcdefghijklmno/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==16) {$ARGV[0]=~ tr/rstuwxyzabcdefghijklmnop/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==17) {$ARGV[0]=~ tr/stuwxyzabcdefghijklmnope/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==18) {$ARGV[0]=~ tr/tuwxyzabcdefghijklmnoper/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==19) {$ARGV[0]=~ tr/uwxyzabcdefghijklmnopers/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==20) {$ARGV[0]=~ tr/wxyzabcdefghijklmnoperst/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==21) {$ARGV[0]=~ tr/xyzabcdefghijklmnoperstu/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==22) {$ARGV[0]=~ tr/yzabcdefghijklmnoperstuw/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==23) {$ARGV[0]=~ tr/zabcdefghijklmnoperstuwx/abcdefghijklmnoperstuwxyz/;
	print "$ARGV[0]";}

if ($ARGV[1]==24) {$ARGV[0]=~ tr/abcdefghijklmnoperstuwxyz/abcdefghijklmnoperstuwxyz/;
	print "Pelne przesuniecie - tekst nie zmienil sie!\r\n";
	print "$ARGV[0]";}

if (int($ARGV[1])>24) {die "\nNiepoprawny argument drugi!\r\nArgument drugi musi byc liczba z przedzialu 1-24\n";}
 }

sub start2 {
if ($ARGV[2]eq'+s') {
	&szyfruj;
	}
elsif ($ARGV[2]eq'+o') {
	&odszyfruj;
	}
else {
die "Argument trzeci musi zawierac:\n- +s - szyfrowanie\n- +o -odszyfrowanie\n";
	}

 }

sub start1 {
if ($#ARGV < 2) {
	print "#######################################\n";
	print "#                                     #\n";
	print "# C-Zar.pl by mtbs!                   #\n";
	print "# OPIS:                               #\n";
	print "#                                     #\n";
	print "# Program sluzy do szyfrowania i      #\n";
	print "# odszyfrowywania ciagu znakow za     #\n"; 
	print "# pomoca SZYFRU CEZARA o przesunieciu #\n";
	print "# od 1 do 24 znakow.                  #\n";
	print "#                                     #\n";
	print "# Uruchomienie:                       #\n";
	print '# np. C:\C-Zar.pl mtbs 3 +s           #';
	print "\n";
	print "#                                     #\n";
	print "# Argument 1 - ciag, max 20 znakow.   #\n";
	print "# Argument 2 - przesuniecie, 1-24.    #\n";
	print "# Argument 3 - szyfrowanie - +s       #\n";
	print "#           - odszyfrowanie - +o      #\n";
	print "#                                     #\n";
	print "#######################################\n";
	print "\n";
	die;
		}
else {&start2;
	}
 }


&start1

Pewnie ktos zaraz zacznie krzyczec po co te ramki itd. - odp. "tak se, ladniej wyglada"...

Teraz moje pytanie... jak uzyc reagex'a match? powiedzmy mam cos takiego:

$ARGV=~m/^\w(1,20)$/

Jak napisac procedure ktora sprawdzala by czy $ARGV jest zgodny z reagexem i pozniej albo die, next itp? Poczytalem troszke dokumentacji ale chyba nie umialem polaczyc faktow .

pozdrawiam,
mtbs!

[Hardiel]

Zalezy jak chcesz uzyć ja np. regexp w bocie uzywałem w taki sposób

if ($text =~ m/[A-Z]/) {
$server->command("quote Kick $chan $nick :Nie Krzycz");

To tylko przyklad w tym wypadku jesli zostanie uzyta jakas duza litera z przedziału A-Z to ktos dostanie kicka wiecej uzyc to [A-Z]{5} w tym wypadku 5 duzych liter o to Ci chodzilo?

[mtbs]

Chodzilo mi raczej o cos w stylu:

$ARGV =~m/^\w(1,20)$/
if ($ARGV[0]ne****** {
 die;
}

Chodzi o to ze jesli ktos poda argument ktory sie nie match'uje -> die... tylko nie mam pojecia jak to zapisac ! Tzn. nie wiem jak zapisac tam gdzie sa gwazdki.

O! albo mam jeszcze jedno pytanie - czy jest mozliwosc aby reagex nam dzielil string? np. mam nr.pesel jako $ARGV - 89110801999 i teraz chce aby zostal podzielony jako $ARGV[0] = 89 $ARGV[1] = 11 $ARGV[2] = 08 $ARGV[3] = 01, tak zebym kazda czesc numeru mogl sprawdzac oddzielnie? Zupelnie nie mam na to pomyslu... :/

[TQM]

na poczatek nalezy pamietac, ze @ARGV oraz zmienne $ARGV[n] sa tylko do udczytu, jesli chcesz robic jakies zmiany musisz wynik w nowych zmiennych zapisac.

Regex jak regex - zalezy co chesz lapac...

if ($ARGV[0] !~ /^\w{1,20}$/) { die "bo tak i juz!\n" };

O! albo mam jeszcze jedno pytanie - czy jest mozliwosc aby reagex nam dzielil string? np. mam nr.pesel jako $ARGV - 89110801999 i teraz chce aby zostal podzielony jako $ARGV[0] = 89 $ARGV[1] = 11 $ARGV[2] = 08 $ARGV[3] = 01, tak zebym kazda czesc numeru mogl sprawdzac oddzielnie? Zupelnie nie mam na to pomyslu... :/

jasne ze mozna i to banalnie prosto...

@czesci = $pesel =~ /\d{2}/g;

jako regex mozesz dac tez /../ i bedzie dokladnie to samo, jesli jednak robisz \d{2} a dlugosc ciagu jest nieparzysta (np 11 cyfr) to dostaniesz 5 elementow a ostatnia cyfra zaginie, jak dasz \d{1,2} to dostaniesz 6 elementow do tablicy, z czego ostatni to ta 11-ta cyfra. Po prostu takie dopasowanie bierze najdluzsze mozliwe fragmenty

\d{5,2} - 2 elementy, bo ostatnia pojedyncza cyfra to mniej niz 2 znaki
\d{,5} - 3 elementy ale dopasowujemy do 5 znakow a potem co zostanie to dojdzie na koncu

EDIT:
Kod C-Zar'a mozna zmienic i znacznie skrocic stosujac nieco inna logike, tzn 'zbudowac' tablice przesuniec dynamicznie, co jest mowiac krotko dosc banalne. Jak bede mial chwilke wolna to przepisze kod, sadze zamiast 24 IF'ow bedzie hmmmm pare linijek tylko

[TQM]

No dobra... skrocilem kod... dokladnie 'pare linii' tak jak przewidzialem.

Co prawda nie podalem zadnych ladnych komunikatow itd ale kod dziala... wiec policzylem ile bylo linii w oryginalnym kodzie mtbs'a a ile jest w moim... 2 funkcje z oryginalnego kodu skrocilem z 53 linii do 1 dokladnie... a wywalajac linie puste i pomijajac banery itd, skrocilem calosc ze 115 do 9 linii.

Zasada dzialania
Doszedlem do wniosku, ze definiowanie IF'ow i sztywne kodowanie translacji to tylko strata czasu i znaczne zuzycie przyciskow Ctrl, C oraz V Postanowilem generowac sobie takie polecenie w locie, dla dowolnego przesuniecia.
Opisalem wiec jakie litery sa dopuszczalne - jest to dopuszczalny alfabet wiadomosci - zostawilem domyslnie male litery alfabetu i to do tego nie kompletne (jest 24 a powinno byc 26, brakuje v oraz q ale zrobilem kopiuj-wklej z kodu mtbs'a aby zachowac max zgodnosc wynikow).

Tak wiec zadanie to wygenerowac w locie tekst przesuniety o N w prawo, poniewaz przesuniecie w lewo nas nie interesuje w ogole (a dlaczego wyjasnie dalej). Tak wiec do kodu...

Wersja 1

my $valid_chars = 'abcdefghijklmnoperstuwxyz';
my @chars = $valid_chars =~ /./g;
sub przesuniecie {
	my $subst;
	for (0 .. $#chars-1) {
		$subst .= $chars[($_+$_[0])%$#chars];
	}
	return $subst;
}
print przesuniecie(3);  # zwraca: defg...xyabc

Najpierw okreslamy sobie dopuszczalny alfabet, pozniej dzielimy to sobie na tablice. Funkcja przesuwajaca leci w petli po calej dlugosci tablicy od 0 do $#tablica czyli najwyzszego numeru elementu w tablicy. Trzeba go jednak pomniejszyc o 1 bo dalej w obliczeniach wychodzi wesolo :P
Glowny krok tej petli to dopisanie na koncu zmiennej $subst znaku znajdujacego sie w tablicy @chars na miejscu

AktualnyNumerPrzebiegu + Przesuniecie mod DlugoscAlfabetu

Daje to tyle, ze idac w prawo po tablicy i dodajac przesuniecie w koncu wyjdziemy poza jej koniec, wiec modulo wraca nas na poczatek tablicy, mozemy tak lazic do oporu - moge podac przesuniecie 12345 i kod bedzie dzialal poprawnie.

Teraz czas skrocic nieco ten kod stosujac standardowe funkcje perla

Wersja 2

sub przesuniecie2 {
	return map { $chars[($_+$_[0])%$#chars] } (0 .. $#chars-1);
}

to samo co wyzej ale stosujac map... dla zwiekszajacego sie licznika wykonaj (doslownie) zwroc element tablicy o numerze <wyliczenia>. Jest tu pewna niescisloc dotyczaca co jest zwracane - skalar czy tablica... kto chce ten doczyta w dokumentacji - tak czy inaczej dziala i daje ten sam efekt co pierwszy kod. Po prostu return() tak jakby magicznie wie jakiego rodzaju zmiennej oczekuje funkcja ktora wywolala funkcje. Print oczekuje raczej skalara a nie tablicy, wiec dostalismy skalar. Roznice bedzie wyraznie widac w wersji koncowej.

No to teraz czas skrocic calosc jeszcze bardziej i sprawdzic czy dziala!

Wersja koncowa

#!/usr/bin/perl
use strict;
my ($text, $shift, $cmd) = @ARGV;
my $valid_chars = 'abcdefghijklmnoperstuwxyz';
my @chars = $valid_chars =~ /./g;
my $moved = join '', map { $chars[($_+$shift)%$#chars] } (0 .. $#chars-1);
$_=$text;
$cmd =~ /s/i ? eval "tr/$valid_chars/$moved/" : eval "tr/$moved/$valid_chars/";
print;

Jak widzicie aby uzyskac skalar $moved musialem zrobic join() bo map() zwrocilo tablice, zupelnie odwrotnie do tego co w wersji 2. Kod chcialem skrocic jeszcze o 3 linie ale nie mam juz czasu siedziec nad tym. 30 minut to i tak dosc dlugo w sumie. Chodzi o to, ze tr() o ile robi interpolacje zmiennych we wzorcu to nie interpoluje zmiennych w podstawieniu. Jesli zrobilibysmy podstawienie aaa z przesunieciem w sumie dowolnym jako tr/$valid_chars/$moved/ to dostaniemy 'ooo' bo 'o' to 3 znak podstawienia (pierwszy to $, drugi m, itd).
Dlatego wlasnie text przypisuje do domyslnej zmiennej, jesli polecenie to 's' robie eval() polecenia ktore poskladalem jako poprawnie INTERPOLOWANY string... tr() bez parametrow robi operacje na $_ wlasnie, tak samo jak ostatnie print()

Ot tyle magii i przygody na dzisiaj. Wracam do pracy hihi...

[mtbs]

huhuhu, elegancko! ja jeszcze do takich zagadnien nie doszedlem, ale daje to kuuupe motywacji i jeszcze wiecej zaciecia ! to co napisales TQM pieknie obrazuje - TIOMWTDI i to w tym jezyku mnie najbardziej jara

pozdrawiam,
mtbs!