...
 
Commits (27)
package Student;
use strict;
use warnings;
use base 'Class::DBI';
__PACKAGE__->connection (qw( dbi:mysql:soa soa eihu2Ahh7xaeKoow9RoeGh9e ));
__PACKAGE__->table ('student');
__PACKAGE__->columns (All => qw( prn fname lname dob branch ));
1;
#!/usr/bin/env perl
use strict;
use warnings;
use Mojolicious::Lite;
use JSON;
use File::Basename qw(dirname);
use lib dirname $0;
use Student;
# helper subroutines
sub is_subset { my %h; undef @h{@{$_[0]}}; delete @h{@{$_[1]}}; !keys %h }
# param 1: ARRAYref of subset
# param 2: ARRAYref of superset
# helper subroutines
my @fields = map { $_->name } Student->columns;
my $pkey = Student->primary_column->name;
any '/' => {
text => <<'EOT',
<pre>
PUT GET POST DELETE
create read update delete
Above requests accepted on following endpoint(s):
1. /student
</pre>
EOT
};
get '/student' => sub {
my $c = shift;
my $params = $c->req->params->to_hash;
my @got_fields = keys %$params;
unless (@got_fields && is_subset \@got_fields, \@fields) {
$c->render (
text => encode_json ({ status => "@fields accepted." }) . "\n",
);
return;
}
my @students = Student->search ( %$params );
my @response;
foreach my $s (@students) {
my $record;
$record->{$_} = $s->$_ foreach @fields;
push @response, $record;
}
$c->render (text => encode_json (\@response) . "\n");
};
del '/student' => sub {
my $c = shift;
my $s = Student->retrieve ( $c->param ($pkey) );
unless ($s) {
$c->render (
text => encode_json ({
status => 'Given record does not exist.',
}) . "\n",
);
return;
}
$c->render (
text => encode_json ({
status =>
$s->delete == 1 ? 'Success.' : 'Unable to delete given record.',
}) . "\n",
);
};
put '/student' => sub {
my $c = shift;
my $params = $c->req->params->to_hash;
my @got_fields = keys %$params;
unless (
is_subset (\@fields, \@got_fields) &&
is_subset (\@got_fields, \@fields)
) {
$c->render (
text => encode_json ({ status => "@fields required." }) . "\n",
);
return;
}
my $s = Student->insert ($params);
$c->render (
text => encode_json ({
status => $s ? 'Success.' : 'Unable to insert given data.',
}) . "\n",
);
};
post '/student' => sub {
my $c = shift;
my $params = $c->req->params->to_hash;
my @got_fields = keys %$params;
unless (@got_fields && is_subset \@got_fields, \@fields) {
$c->render (
text => encode_json ({ status => "@fields accepted." }) . "\n",
);
return;
}
my $s = Student->retrieve ($params->{$pkey});
unless ($s) {
$c->render (
text => encode_json ({
status => 'Unable to retrive required record.',
}) . "\n",
);
return;
}
$s->$_ ($params->{$_}) foreach @got_fields;
$c->render (
text => encode_json ({
status =>
$s->update == 1 ? 'Success.' : 'Unable to update given record.',
}) . "\n",
);
};
app->start;
__END__
Usage from Terminal:
$ ./rest_crud.pl get '/student?prn=506'
drop database soa;
create database soa;
use soa;
create table student (
prn int unsigned primary key,
fname char(100) not null,
lname char(100) not null,
dob date not null,
branch char(100) not null
);
insert into student values
(506, 'Ankit', 'Pati', '1996-04-02', 'IT'),
(543, 'Tiashaa', 'Chatterjee', '1995-12-13', 'CS');
......@@ -7,6 +7,8 @@ use Mojolicious::Lite;
any '/' => {
text => <<'EOT',
<pre>
GET and POST requests accepted at the following end-points:
1. /add
Parameters:
......@@ -20,6 +22,8 @@ GET and POST requests accepted at the following end-points:
3. /factors
unsigned num;
Eg. /factors?num=1849
</pre>
EOT
};
......
<VirtualHost *:80>
ServerAdmin contact@ankitpati.in
DocumentRoot /var/www/html/SOAP/
</VirtualHost>
<Directory /var/www/html/SOAP>
AddHandler cgi-script .cgi
Options +ExecCGI
</Directory>
#!/usr/bin/env perl
use strict;
use warnings;
use SOAP::Lite;
my $client = new SOAP::Lite (
proxy => 'http://localhost/soapserver.cgi',
uri => 'urn:AnkitPatiSOAPServer',
);
print "Addition\n", $client->add(43, 5, 50, 55)->result, "\n\n";
print "Factorial\n", $client->factorial(5)->result, "\n\n";
my $values = $client->factors (1849);
my @factors = ($values->result, $values->paramsout);
print "Factors\n@factors\n";
#!/usr/bin/env perl
use strict;
use warnings;
use SOAP::Transport::HTTP;
SOAP::Transport::HTTP::CGI->dispatch_to('AnkitPatiSOAPServer')->handle;
package AnkitPatiSOAPServer;
sub add {
my $self = shift;
my $sum = 0;
$sum += $_ foreach @_;
return $sum;
}
sub factorial {
my $self = shift;
my $n = shift;
my $factorial = 1;
$factorial *= $_ foreach 1 .. $n;
return $factorial;
}
sub factors {
my $self = shift;
my $n = shift;
my @factors;
foreach (1 .. $n) {
push @factors, $_ unless $n % $_;
}
return @factors;
}
1;
<?xml version="1.0" encoding="UTF-8"?>
<bookstore>
<book category="cooking">
<title lang="en">Everyday Italian</title>
<author>Giada De Laurentiis</author>
<year>2005</year>
<price>30.00</price>
</book>
<book category="children">
<title lang="en">Harry Potter</title>
<author>J K. Rowling</author>
<year>2005</year>
<price>29.99</price>
</book>
<book category="web">
<title lang="en">XQuery Kick Start</title>
<author>James McGovern</author>
<author>Per Bothner</author>
<author>Kurt Cagle</author>
<author>James Linn</author>
<author>Vaidyanathan Nagarajan</author>
<year>2003</year>
<price>49.99</price>
</book>
</bookstore>
......@@ -93,10 +93,8 @@ EOM
my @foods = $dom->findnodes ('//food');
@foods = sort {
$a->findvalue ('calories') <=>
$b->findvalue ('calories')
} @foods;
@foods = sort { $a->findvalue ('calories') <=> $b->findvalue ('calories') }
@foods;
print $_->findvalue ('name'), "\n\t", $_->findvalue ('description'), "\n"
foreach @foods;
......
#!/usr/bin/env perl
package AnkitPati::XMLFinalExam;
use strict;
use warnings;
use File::Basename qw(dirname);
use XML::LibXML;
sub answer1 {
print <<'EOM';
Question 1
List all the authors of a book with maximum number of authors.
Answer 1
EOM
my $dom = shift;
my @books = $dom->findnodes ('//book');
my $book_max_authors = shift @books;
foreach my $book (@books) {
my @authors_max = $book_max_authors->findnodes ('./author');
my @authors = $book->findnodes ('./author');
$book_max_authors = $book if @authors > @authors_max;
}
foreach my $author ($book_max_authors->findnodes ('./author')) {
print $author->to_literal, "\n";
}
}
sub answer2 {
print <<'EOM';
Question 2
Display the price of a given book title.
Answer 2
EOM
my $dom = shift;
my $given = shift;
print $dom->findvalue ("//book/title[text() = '$given']/../price"), "\n";
}
sub answer3 {
print <<'EOM';
Question 3
List all the books below a given price.
Answer 3
EOM
my $dom = shift;
my $given = shift;
print $_->to_literal, "\n"
foreach $dom->findnodes ("//book/price[text() < '$given']/../title");
}
sub answer4 {
print <<'EOM';
Question 4
Get all the book titles of a given category.
Answer 4
EOM
my $dom = shift;
my $given = shift;
print $_->to_literal, "\n"
foreach $dom->findnodes ("//book[\@category = '$given']/title");
}
sub main {
my $filename = dirname ($0) . '/xml/books.xml';
my $dom = eval { XML::LibXML->load_xml (location => $filename) };
die "Malformed XML file!\n" if $@;
answer1 $dom;
answer2 $dom, 'XQuery Kick Start';
answer3 $dom, 35.50;
answer4 $dom, 'children';
}
main unless caller;
1;
package WebSOA::SOAP::Handler;
use strict;
use warnings;
use File::Basename qw(dirname);
use SOAP::Transport::HTTP;
my $server = SOAP::Transport::HTTP::Apache
->dispatch_to (dirname (__FILE__) . '/Services');
sub handler {
$server->handler (@_);
}
1;
package AddNumbers;
sub getSum {
my $self = shift;
my $sum = 0;
$sum += $_ foreach @_;
return $sum;
}
1;
package Factorial;
sub getFactorial {
my $self = shift;
my $n = shift;
my $factorial = 1;
$factorial *= $_ foreach 1 .. $n;
return $factorial;
}
1;
package Factors;
use SOAP::Lite;
sub getFactors {
my $self = shift;
my $n = shift;
my @factors;
foreach (1 .. $n/2) {
push @factors, $_ unless $n % $_;
}
return SOAP::Data->name (factors => @factors);
}
1;
package WebSOA::Startup;
use strict;
use warnings;
use lib qw(/var/www/websoa/perl);
1;
#!/usr/bin/env perl
use strict;
use warnings;
use SOAP::Lite;
my $client = new SOAP::Lite ( proxy => 'http://localhost/soap/' );
$client->uri ('urn:AddNumbers');
print "Addition\n", $client->getSum (43, 5, 50, 55)->result, "\n\n";
$client->uri ('urn:Factorial');
print "Factorial\n", $client->getFactorial (5)->result, "\n\n";
$client->uri ('urn:Factors');
print "Factors\n";
my $factors = $client->getFactors (50);
my $f = $factors->name ('factors');
use Data::Dumper; print Dumper $f;
__END__
print "$_ " foreach @factors;
print "\n\n";
<VirtualHost *:80>
ServerAdmin contact@ankitpati.in
DocumentRoot /var/www/websoa/html
<Directory "/var/www/websoa/html">
AllowOverride None
Require all granted
</Directory>
LoadModule apreq_module module/mod_apreq2.so
LoadModule perl_module module/mod_perl.so
PerlRequire /var/www/websoa/perl/WebSOA/Startup.pm
<Location "/">
SetHandler perl-script
PerlHandler WebSOA::SOAP::Handler
</Location>
</VirtualHost>
<?xml version="1.0" encoding="utf-8"?>
<users>
<user type="admin">
<name>Ankit Pati</name>
<email>contact@ankitpati.in</email>
<email>ankit.pati@sitpune.edu.in</email>
<address>
A-435 Some Building
Some Street
Some City--101011
</address>
</user>
<user>
<name>Tiashaa Chatterjee</name>
<email>tc@gmail.com</email>
<address>
B-543 Some Other Building
Some Other Street
Some Other City--000101
</address>
</user>
</users>
#!/usr/bin/env php
<?php
sizeof($argv) === 2 or die("Usage:\n\txmlparse.php <filename>\n");
($users = @simplexml_load_file($argv[1])) !== false
or die("$argv[1] cannot be opened.\n");
print_r($users);
#!/usr/bin/env perl
package AnkitPati::XMLParse;
use strict;
use warnings;
use XML::Parser;
use XML::Parser::EasyTree;
use XML::Generator;
$XML::Parser::EasyTree::Noempty = 1;
sub unravel {
my $elem = shift;
my $level = shift // 0;
if ('ARRAY' eq ref $elem) {
unravel ($_, $level + 1) foreach @$elem;
print "\n\n";
return;
}
if ($elem->{type} eq 't') { # print text elements directly
print ' 'x($level-1), $elem->{content};
print "\n";
return;
}
print ' 'x($level-1), "Name: $elem->{name}\n";
if (%{$elem->{attrib}}) {
print ' 'x($level-1), "Attributes:\n";
print ' 'x($level-1), " $_: $elem->{attrib}{$_}\n"
foreach sort keys %{$elem->{attrib}};
}
print ' 'x($level-1), "Content:\n";
unravel ($elem->{content}, $level);
}
sub main {
@ARGV == 1 or die "Usage:\n\t${\(split m|/|, $0)[-1]} <filename>\n";
my $filename = shift @ARGV;
my $prsr = new XML::Parser (Style => 'EasyTree');
my $tree;
eval {
$tree = $prsr->parsefile ($filename);
};
die "Malformed XML file!\n" if $@;
unravel $tree;
}
main unless caller;
1;