This shows you the differences between two versions of the page.
Both sides previous revision Previous revision Next revision | Previous revision Next revision Both sides next revision | ||
язык_программирования_perl [2014/03/14 11:17] val [Пример 1] |
язык_программирования_perl [2020/04/03 16:23] val [Пример 5] |
||
---|---|---|---|
Line 17: | Line 17: | ||
==== Пример 1 ==== | ==== Пример 1 ==== | ||
+ | * Отключение буферизации вывода | ||
* Чтение данных с STDIN | * Чтение данных с STDIN | ||
* Регулярный разбор полей строки | * Регулярный разбор полей строки | ||
Line 24: | Line 25: | ||
</code><code> | </code><code> | ||
#!/usr/bin/perl | #!/usr/bin/perl | ||
+ | |||
+ | $|=1; | ||
while(<>) { | while(<>) { | ||
Line 42: | Line 45: | ||
* Обработка аргументов | * Обработка аргументов | ||
* Использование внешних утилит | * Использование внешних утилит | ||
- | * Регулярный разбор полей строки | + | * Регулярный разбор полей строковой переменной |
<code> | <code> | ||
Line 54: | Line 57: | ||
my ($ip) = @ARGV; | my ($ip) = @ARGV; | ||
- | if (not defined $ip) { | + | unless($ip) { |
die "Need ip\n"; | die "Need ip\n"; | ||
} | } | ||
Line 68: | Line 71: | ||
</code> | </code> | ||
- | ==== Пример с mysql (autoincrement, transaction, error handling) ==== | + | ==== Пример 3 ==== |
+ | |||
+ | * Использование MySQL | ||
+ | * autoincrement | ||
+ | * transaction | ||
+ | * error handling | ||
+ | |||
<code> | <code> | ||
CREATE TABLE | CREATE TABLE | ||
Line 87: | Line 96: | ||
a INT NOT NULL | a INT NOT NULL | ||
); | ); | ||
+ | </code><code> | ||
+ | # cat example3.pl | ||
</code><code> | </code><code> | ||
#!/usr/bin/perl | #!/usr/bin/perl | ||
Line 118: | Line 129: | ||
$sth = $dbh->prepare(qq{select LAST_INSERT_ID()}); | $sth = $dbh->prepare(qq{select LAST_INSERT_ID()}); | ||
$sth->execute() or next MAINLOOP; | $sth->execute() or next MAINLOOP; | ||
- | (my $a)=$sth->fetchrow_array(); | + | my ($a)=$sth->fetchrow_array(); |
print "a = $a; b = $b\n"; | print "a = $a; b = $b\n"; | ||
Line 142: | Line 153: | ||
} | } | ||
</code> | </code> | ||
+ | |||
+ | ==== Пример 4 ==== | ||
+ | |||
+ | * Использование UTF8 | ||
+ | * Работа с XML форматом ([[https://stackoverflow.com/questions/46167194/get-value-of-elements-using-xmldom|Get value of elements using XML::DOM]]) | ||
+ | |||
+ | === Исходный файл === | ||
+ | <code> | ||
+ | # cat postgraduate.xml | ||
+ | </code><code> | ||
+ | <?xml version="1.0" encoding="UTF-8"?> | ||
+ | <service> | ||
+ | <postgraduates> | ||
+ | <postgraduate uuid="f601dc22-8572-11e2-af21-00270e0c47d1" pcn="" lastname="Аббаси" firstname="Домиан" middlename=""> | ||
+ | <speciality uuid="a15a5280-8572-11e2-a896-00270e0c47d1" code="05.02.05" name="Роботы, мехатроника и робототехнические системы"/> | ||
+ | <tutor uuid="a334e516-8572-11e2-a6e3-00270e0c47d1" lastname="Медведев" firstname="Владимир" middlename="Степанович"/> | ||
+ | <dismissal> | ||
+ | <item dismissal_date="2001-12-25" cause_uuid="26e23a26-c0e4-11df-96e9-003048c6b34e" cause="окончание срока обучения" order_num="" order_date=""/> | ||
+ | </dismissal> | ||
+ | </postgraduate> | ||
+ | <postgraduate uuid="ba68ada2-8573-11e2-a21a-00270e0c47d1" pcn="17" lastname="Бородулин" firstname="Денис" middlename="Сергеевич"> | ||
+ | <speciality uuid="a17a23d0-8572-11e2-8061-00270e0c47d1" code="05.11.03" name="Приборы навигации"/> | ||
+ | <tutor uuid="5667f692-9908-4573-adde-78bef03ab3d7" lastname="Коновалов" firstname="Сергей" middlename="Феодосьевич"/> | ||
+ | <dismissal> | ||
+ | <item dismissal_date="2013-04-15" cause_uuid="26e22ab7-c0e4-11df-96e9-003048c6b34e" cause="по аттестации" order_num="02.01-04/21" order_date="2013-04-22"/> | ||
+ | </dismissal> | ||
+ | </postgraduate> | ||
+ | </postgraduates> | ||
+ | </service> | ||
+ | </code> | ||
+ | |||
+ | === Текст программы === | ||
+ | <code> | ||
+ | # cat xml2txt.pl | ||
+ | </code><code> | ||
+ | #!/usr/bin/perl -w | ||
+ | |||
+ | use XML::DOM; | ||
+ | use strict; | ||
+ | use utf8; | ||
+ | |||
+ | binmode(STDOUT,':utf8'); | ||
+ | |||
+ | my $parser = new XML::DOM::Parser; | ||
+ | my $doc = $parser->parsefile ('postgraduate.xml'); | ||
+ | my @nodes =$doc->getElementsByTagName("postgraduate"); | ||
+ | |||
+ | foreach my $node (@nodes) { | ||
+ | |||
+ | # print $node->toString; | ||
+ | | ||
+ | my $uuid = $node->getAttributeNode ("uuid")->getValue; | ||
+ | my $lastname = $node->getAttributeNode ("lastname")->getValue; | ||
+ | my $firstname = $node->getAttributeNode ("firstname")->getValue; | ||
+ | my $middlename = $node->getAttributeNode ("middlename")->getValue; | ||
+ | print "$uuid,$lastname,$firstname,$middlename\n"; | ||
+ | } | ||
+ | </code> | ||
+ | ==== Пример 5 ==== | ||
+ | |||
+ | * Работа с Communigate | ||
+ | |||
+ | <code> | ||
+ | # wget https://www.communigate.com/CGPerl/CLI.pm | ||
+ | |||
+ | # mv CLI.pm /etc/perl/ | ||
+ | |||
+ | # cat addcgpuser.pl | ||
+ | </code><code> | ||
+ | #!/usr/bin/perl | ||
+ | |||
+ | use strict; | ||
+ | use CLI; | ||
+ | |||
+ | my ($AccountName,$RealName,$Password) = @ARGV; | ||
+ | |||
+ | my $cli = new CGP::CLI( { PeerAddr => '127.0.0.1', | ||
+ | PeerPort => 106, | ||
+ | login => 'postmaster', | ||
+ | password => 'Pa$$w0rd' | ||
+ | } ) | ||
+ | || die "Can't login to CGPro: ".$CGP::ERR_STRING."\n"; | ||
+ | |||
+ | |||
+ | my $UserData; | ||
+ | @$UserData{'RealName'}=$RealName; | ||
+ | @$UserData{'Password'}=$Password; | ||
+ | |||
+ | $cli->CreateAccount(accountName => $AccountName, | ||
+ | settings => $UserData) | ||
+ | || die "Can't create account: ".$CGP::ERR_STRING."\n"; | ||
+ | |||
+ | $cli->Logout; | ||
+ | |||
+ | exit; | ||
+ | </code><code> | ||
+ | mail# ./addcgpuser.pl user3 'Сидор Сидорович Сидоров' cpassword3 | ||
+ | </code> | ||
+ | |||
+ | ==== Пример 6 ==== | ||
+ | |||
+ | * Perl CGI | ||
+ | * http://....hello.pl?name=ivanov | ||
+ | |||
+ | <code> | ||
+ | $ cat hello.pl | ||
+ | </code><code> | ||
+ | #!/usr/bin/perl | ||
+ | |||
+ | use strict; | ||
+ | use CGI; | ||
+ | |||
+ | my $q=new CGI(); | ||
+ | my $name=$q->param('name'); | ||
+ | print qq| | ||
+ | <html> | ||
+ | <body> | ||
+ | <h1>Hello $name</h1> | ||
+ | </body> | ||
+ | </html> | ||
+ | |; | ||
+ | </code> | ||
+ | |||
+ | ==== Ссылки ==== | ||
+ | |||
+ | * [[http://codecry.com/perl/random-password-generator|Random Password Generator in Perl]] | ||
+ | * [[http://www.xgu.ru/wiki/%D0%A2%D1%80%D0%B0%D0%BD%D1%81%D0%BB%D0%B8%D1%82|Транслит]] |