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:19] val [Пример с mysql (autoincrement, transaction, error handling)] |
язык_программирования_perl [2019/09/24 12:42] val [Пример 2] |
||
---|---|---|---|
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 54: | Line 57: | ||
my ($ip) = @ARGV; | my ($ip) = @ARGV; | ||
- | if (not defined $ip) { | + | unless($ip) { |
die "Need ip\n"; | die "Need ip\n"; | ||
} | } | ||
Line 126: | 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 149: | Line 152: | ||
$dbh->rollback(); | $dbh->rollback(); | ||
} | } | ||
+ | </code> | ||
+ | |||
+ | ==== Пример 4 ==== | ||
+ | |||
+ | * Использование UTF8 | ||
+ | * Работа с XML форматом | ||
+ | |||
+ | === Исходный файл === | ||
+ | <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) { | ||
+ | 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 http://www.stalker.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> | </code> |