# Chapter 21: RESTful APIs and Web Services *"In the interconnected world of modern software, Perl serves as both a capable API consumer and a powerful service provider."* ## The Web Services Landscape In 2025, RESTful APIs remain the lingua franca of web services. While GraphQL and gRPC have their niches, REST's simplicity and ubiquity make it essential for any systems programmer. Perl, with its excellent HTTP libraries and JSON handling, excels at both consuming and providing web services. ## Building a RESTful API Server Let's start by building a complete REST API using Mojolicious, Perl's most modern web framework: ```perl #!/usr/bin/env perl use Mojolicious::Lite -signatures; use Mojo::JSON qw(encode_json decode_json); use DBI; use Try::Tiny; # Initialize database my $dbh = DBI->connect("dbi:SQLite:dbname=api.db","","", { RaiseError => 1, PrintError => 0, AutoCommit => 1, }); # Create tables if needed $dbh->do(q{ CREATE TABLE IF NOT EXISTS users ( id INTEGER PRIMARY KEY AUTOINCREMENT, username TEXT UNIQUE NOT NULL, email TEXT UNIQUE NOT NULL, created_at DATETIME DEFAULT CURRENT_TIMESTAMP, updated_at DATETIME DEFAULT CURRENT_TIMESTAMP ) }); $dbh->do(q{ CREATE TABLE IF NOT EXISTS posts ( id INTEGER PRIMARY KEY AUTOINCREMENT, user_id INTEGER NOT NULL, title TEXT NOT NULL, content TEXT, published BOOLEAN DEFAULT 0, created_at DATETIME DEFAULT CURRENT_TIMESTAMP, updated_at DATETIME DEFAULT CURRENT_TIMESTAMP, FOREIGN KEY (user_id) REFERENCES users(id) ) }); # Middleware for JSON error handling hook before_dispatch => sub ($c) { $c->res->headers->header('Content-Type' => 'application/json'); }; hook after_dispatch => sub ($c) { if ($c->res->code >= 400 && !$c->res->body) { $c->render(json => { error => $c->res->message || 'An error occurred', status => $c->res->code }); } }; # Helper for database operations helper db => sub { $dbh }; # Helper for pagination helper paginate => sub ($c, $query, $count_query, @params) { my $page = $c->param('page') // 1; my $limit = $c->param('limit') // 10; my $offset = ($page - 1) * $limit; # Get total count my ($total) = $dbh->selectrow_array($count_query, {}, @params); # Get paginated results my $results = $dbh->selectall_arrayref( "$query LIMIT ? OFFSET ?", { Slice => {} }, @params, $limit, $offset ); return { data => $results, meta => { page => $page, limit => $limit, total => $total, pages => int(($total + $limit - 1) / $limit) } }; }; # Routes # Health check endpoint get '/health' => sub ($c) { $c->render(json => { status => 'healthy', timestamp => time(), version => '1.0.0' }); }; # User endpoints group { under '/api/v1'; # List users with pagination get '/users' => sub ($c) { my $result = $c->paginate( "SELECT * FROM users ORDER BY created_at DESC", "SELECT COUNT(*) FROM users" ); $c->render(json => $result); }; # Get single user get '/users/:id' => sub ($c) { my $id = $c->param('id'); my $user = $dbh->selectrow_hashref( "SELECT * FROM users WHERE id = ?", {}, $id ); return $c->render(json => { error => 'User not found' }, status => 404) unless $user; # Get user's posts $user->{posts} = $dbh->selectall_arrayref( "SELECT id, title, published FROM posts WHERE user_id = ?", { Slice => {} }, $id ); $c->render(json => { data => $user }); }; # Create user post '/users' => sub ($c) { my $json = $c->req->json; # Validation my @required = qw(username email); for my $field (@required) { return $c->render( json => { error => "Missing required field: $field" }, status => 400 ) unless $json->{$field}; } # Check for duplicates my $existing = $dbh->selectrow_hashref( "SELECT id FROM users WHERE username = ? OR email = ?", {}, $json->{username}, $json->{email} ); return $c->render( json => { error => 'Username or email already exists' }, status => 409 ) if $existing; # Insert user try { $dbh->do( "INSERT INTO users (username, email) VALUES (?, ?)", {}, $json->{username}, $json->{email} ); my $id = $dbh->last_insert_id(undef, undef, 'users', undef); my $user = $dbh->selectrow_hashref( "SELECT * FROM users WHERE id = ?", {}, $id ); $c->render(json => { data => $user }, status => 201); } catch { $c->render(json => { error => "Failed to create user: $_" }, status => 500); }; }; # Update user put '/users/:id' => sub ($c) { my $id = $c->param('id'); my $json = $c->req->json; # Check if user exists my $user = $dbh->selectrow_hashref( "SELECT * FROM users WHERE id = ?", {}, $id ); return $c->render(json => { error => 'User not found' }, status => 404) unless $user; # Build update query my @fields; my @values; for my $field (qw(username email)) { if (exists $json->{$field}) { push @fields, "$field = ?"; push @values, $json->{$field}; } } return $c->render(json => { error => 'No fields to update' }, status => 400) unless @fields; push @values, $id; try { $dbh->do( "UPDATE users SET " . join(', ', @fields) . ", updated_at = CURRENT_TIMESTAMP WHERE id = ?", {}, @values ); $user = $dbh->selectrow_hashref( "SELECT * FROM users WHERE id = ?", {}, $id ); $c->render(json => { data => $user }); } catch { $c->render(json => { error => "Failed to update user: $_" }, status => 500); }; }; # Delete user del '/users/:id' => sub ($c) { my $id = $c->param('id'); my $user = $dbh->selectrow_hashref( "SELECT * FROM users WHERE id = ?", {}, $id ); return $c->render(json => { error => 'User not found' }, status => 404) unless $user; try { $dbh->begin_work; # Delete user's posts first $dbh->do("DELETE FROM posts WHERE user_id = ?", {}, $id); # Delete user $dbh->do("DELETE FROM users WHERE id = ?", {}, $id); $dbh->commit; $c->render(json => { message => 'User deleted successfully' }); } catch { $dbh->rollback; $c->render(json => { error => "Failed to delete user: $_" }, status => 500); }; }; # Post endpoints # List all posts get '/posts' => sub ($c) { my $published_only = $c->param('published') // 0; my $where = $published_only ? "WHERE published = 1" : ""; my $result = $c->paginate( "SELECT p.*, u.username FROM posts p JOIN users u ON p.user_id = u.id $where ORDER BY p.created_at DESC", "SELECT COUNT(*) FROM posts p $where" ); $c->render(json => $result); }; # Create post post '/posts' => sub ($c) { my $json = $c->req->json; # Validation my @required = qw(user_id title content); for my $field (@required) { return $c->render( json => { error => "Missing required field: $field" }, status => 400 ) unless defined $json->{$field}; } # Check if user exists my $user = $dbh->selectrow_hashref( "SELECT id FROM users WHERE id = ?", {}, $json->{user_id} ); return $c->render(json => { error => 'User not found' }, status => 404) unless $user; try { $dbh->do( "INSERT INTO posts (user_id, title, content, published) VALUES (?, ?, ?, ?)", {}, $json->{user_id}, $json->{title}, $json->{content}, $json->{published} // 0 ); my $id = $dbh->last_insert_id(undef, undef, 'posts', undef); my $post = $dbh->selectrow_hashref( "SELECT p.*, u.username FROM posts p JOIN users u ON p.user_id = u.id WHERE p.id = ?", {}, $id ); $c->render(json => { data => $post }, status => 201); } catch { $c->render(json => { error => "Failed to create post: $_" }, status => 500); }; }; # Search posts get '/posts/search' => sub ($c) { my $query = $c->param('q'); return $c->render(json => { error => 'Query parameter required' }, status => 400) unless $query; my $posts = $dbh->selectall_arrayref( "SELECT p.*, u.username FROM posts p JOIN users u ON p.user_id = u.id WHERE p.title LIKE ? OR p.content LIKE ? ORDER BY p.created_at DESC LIMIT 20", { Slice => {} }, "%$query%", "%$query%" ); $c->render(json => { data => $posts }); }; }; # Start the application app->start; ``` ## Consuming External APIs Now let's build a comprehensive API client that demonstrates best practices: ```perl #!/usr/bin/env perl use Modern::Perl '2023'; use feature 'signatures'; no warnings 'experimental::signatures'; package API::Client { use Moo; use Types::Standard qw(Str Int HashRef Bool); use LWP::UserAgent; use HTTP::Request; use JSON::XS; use URI; use Try::Tiny; use Time::HiRes qw(time); use Cache::LRU; use Log::Any qw($log); has base_url => ( is => 'ro', isa => Str, required => 1, ); has api_key => ( is => 'ro', isa => Str, predicate => 'has_api_key', ); has timeout => ( is => 'ro', isa => Int, default => 30, ); has retry_count => ( is => 'ro', isa => Int, default => 3, ); has retry_delay => ( is => 'ro', isa => Int, default => 1, ); has cache_ttl => ( is => 'ro', isa => Int, default => 300, # 5 minutes ); has user_agent => ( is => 'lazy', isa => sub { ref $_[0] eq 'LWP::UserAgent' }, ); has json => ( is => 'lazy', default => sub { JSON::XS->new->utf8->pretty->canonical }, ); has cache => ( is => 'lazy', default => sub { Cache::LRU->new(size => 100) }, ); has _cache_timestamps => ( is => 'ro', default => sub { {} }, ); sub _build_user_agent ($self) { my $ua = LWP::UserAgent->new( timeout => $self->timeout, agent => 'Perl API Client/1.0', ); # Add default headers $ua->default_header('Accept' => 'application/json'); $ua->default_header('Content-Type' => 'application/json'); # Add API key if provided if ($self->has_api_key) { $ua->default_header('Authorization' => 'Bearer ' . $self->api_key); } return $ua; } sub request ($self, $method, $endpoint, $params = {}, $body = undef) { # Build full URL my $uri = URI->new($self->base_url . $endpoint); # Add query parameters for GET requests if ($method eq 'GET' && $params && %$params) { $uri->query_form($params); } # Check cache for GET requests my $cache_key = "$method:$uri"; if ($method eq 'GET') { my $cached = $self->_get_cached($cache_key); return $cached if $cached; } # Prepare request my $request = HTTP::Request->new($method => $uri); # Add body for POST/PUT/PATCH requests if ($body && ($method eq 'POST' || $method eq 'PUT' || $method eq 'PATCH')) { my $json_body = ref $body ? $self->json->encode($body) : $body; $request->content($json_body); } # Execute request with retries my $response; my $attempt = 0; my $last_error; while ($attempt < $self->retry_count) { $attempt++; $log->debug("API request attempt $attempt: $method $uri"); my $start_time = time(); try { $response = $self->user_agent->request($request); my $elapsed = sprintf("%.3f", time() - $start_time); $log->debug("API response: " . $response->code . " (${elapsed}s)"); # Check for rate limiting if ($response->code == 429) { my $retry_after = $response->header('Retry-After') || $self->retry_delay * $attempt; $log->warn("Rate limited, waiting ${retry_after}s"); sleep($retry_after); next; } # Success or client error (no retry needed) if ($response->is_success || ($response->code >= 400 && $response->code < 500)) { last; } # Server error - retry if ($response->code >= 500) { $last_error = "Server error: " . $response->status_line; $log->warn($last_error); sleep($self->retry_delay * $attempt) if $attempt < $self->retry_count; next; } } catch { $last_error = "Request failed: $_"; $log->error($last_error); sleep($self->retry_delay * $attempt) if $attempt < $self->retry_count; }; } # Check final response unless ($response) { die "API request failed after $attempt attempts: $last_error"; } unless ($response->is_success) { my $error = $response->status_line; if ($response->content) { try { my $error_data = $self->json->decode($response->content); $error = $error_data->{error} || $error_data->{message} || $error; } catch { # Use status line if JSON decode fails }; } die "API error: $error"; } # Parse response my $data; if ($response->content) { try { $data = $self->json->decode($response->content); } catch { die "Failed to parse API response: $_"; }; } # Cache successful GET requests if ($method eq 'GET' && $data) { $self->_set_cached($cache_key, $data); } return $data; } sub _get_cached ($self, $key) { my $timestamp = $self->_cache_timestamps->{$key}; return unless $timestamp; if (time() - $timestamp > $self->cache_ttl) { delete $self->_cache_timestamps->{$key}; $self->cache->remove($key); return; } return $self->cache->get($key); } sub _set_cached ($self, $key, $value) { $self->cache->set($key => $value); $self->_cache_timestamps->{$key} = time(); } # Convenience methods sub get ($self, $endpoint, $params = {}) { return $self->request('GET', $endpoint, $params); } sub post ($self, $endpoint, $body = {}, $params = {}) { return $self->request('POST', $endpoint, $params, $body); } sub put ($self, $endpoint, $body = {}, $params = {}) { return $self->request('PUT', $endpoint, $params, $body); } sub patch ($self, $endpoint, $body = {}, $params = {}) { return $self->request('PATCH', $endpoint, $params, $body); } sub delete ($self, $endpoint, $params = {}) { return $self->request('DELETE', $endpoint, $params); } } # Example: GitHub API client package GitHub::Client { use Moo; use Types::Standard qw(Str); extends 'API::Client'; has '+base_url' => ( default => 'https://api.github.com', ); has username => ( is => 'ro', isa => Str, required => 1, ); sub user_repos ($self) { return $self->get("/users/" . $self->username . "/repos", { sort => 'updated', per_page => 100, }); } sub repo_info ($self, $repo) { return $self->get("/repos/" . $self->username . "/$repo"); } sub repo_issues ($self, $repo, $state = 'open') { return $self->get("/repos/" . $self->username . "/$repo/issues", { state => $state, per_page => 100, }); } sub create_issue ($self, $repo, $title, $body, $labels = []) { return $self->post("/repos/" . $self->username . "/$repo/issues", { title => $title, body => $body, labels => $labels, }); } } # Usage example use Log::Any::Adapter 'Stdout'; my $github = GitHub::Client->new( username => 'torvalds', api_key => $ENV{GITHUB_TOKEN}, # Optional ); try { # Get user's repositories my $repos = $github->user_repos(); say "Found " . scalar(@$repos) . " repositories"; for my $repo (@$repos) { printf("%-30s ⭐ %-6d 🍴 %-6d %s\n", $repo->{name}, $repo->{stargazers_count}, $repo->{forks_count}, $repo->{description} // '' ); } # Get specific repo details my $linux = $github->repo_info('linux'); say "\nLinux kernel repo:"; say " Stars: " . $linux->{stargazers_count}; say " Forks: " . $linux->{forks_count}; say " Open Issues: " . $linux->{open_issues_count}; } catch { warn "Error: $_"; }; ``` ## WebSocket Communication For real-time applications, WebSocket support is essential: ```perl #!/usr/bin/env perl use Mojolicious::Lite -signatures; use Mojo::JSON qw(encode_json decode_json); # Store active connections my %clients; my $client_id = 0; # WebSocket chat server websocket '/ws' => sub ($c) { my $id = ++$client_id; # Store connection $clients{$id} = $c; # Send welcome message $c->send(encode_json({ type => 'system', message => "Welcome! You are client #$id", timestamp => time(), })); # Notify others of new connection broadcast({ type => 'system', message => "Client #$id joined", timestamp => time(), }, $id); # Handle incoming messages $c->on(message => sub ($c, $msg) { my $data; # Try to parse JSON eval { $data = decode_json($msg) }; if ($@) { $c->send(encode_json({ type => 'error', message => 'Invalid JSON', })); return; } # Handle different message types if ($data->{type} eq 'chat') { broadcast({ type => 'chat', from => "Client #$id", message => $data->{message}, timestamp => time(), }); } elsif ($data->{type} eq 'ping') { $c->send(encode_json({ type => 'pong', timestamp => time(), })); } }); # Handle disconnection $c->on(finish => sub ($c, $code, $reason) { delete $clients{$id}; broadcast({ type => 'system', message => "Client #$id disconnected", timestamp => time(), }); }); }; sub broadcast ($message, $exclude_id = undef) { my $json = encode_json($message); for my $id (keys %clients) { next if defined $exclude_id && $id == $exclude_id; $clients{$id}->send($json); } } # Serve HTML client get '/' => sub ($c) { $c->render(inline => <<'HTML');