<%shared> # Variables declared in the shared section are visible in all of the # methods in this Mason component. # # Split the dhandler args into a disk name and a path on that disk. # A request for /diskmags/foo/bar/baz would make $disk = 'foo' and # @path = ('bar', 'baz'). These are validated later in the course of # the request in the validate-request method. my ($disk, @path) = split m|/|, $m->dhandler_arg; # $disk_href will contain the database record for the requested disk. # $object_href will contain the database record for the requested object # (the file or directory the user requested--the last element in the # @path array.) Both of these are populated in the validate-request # method. # # $special will be the name of a method to execute in certain special # situations (e.g. disk scan or dump requested.) my ($disk_href, $object_href, $special); <%once> use HTML::Entities; use List::Util qw(sum); use File::MMagic; <%init> $m->comp('SELF:validate-request'); # Apache will not set a content type for a dhandler under mod_perl. We # set default to text/html here, but we may override that later on for # e.g. downloading a file. $r->content_type('text/html'); # * If $special is defined, then we need to execute that method in # response to some special request. # * If there was no disk name (i.e. there were no dhandler args), then # show the user an index of all disks. # * If there was a disk name but no path (i.e. the user requested the root # directory of the disk), or there was a path and that path is to a # directory, then we're showing a directory. # * Otherwise the user requested a file and we need to handle that. if (defined $special) { $m->comp("SELF:$special"); } elsif (!defined $disk) { $m->comp('SELF:show-disk-index', %ARGS); } elsif (!scalar @path || $object_href->{dir}) { # Make sure URI has trailing slash, otherwise links will be broken! if ($r->uri !~ m|/$|) { $m->redirect($r->uri . '/'); } else { $m->comp('SELF:show-dir', %ARGS); } } else { $m->comp('SELF:handle-file', %ARGS); } <%method validate-request> <%init> # There's nothing to validate if there were no dhandler args. return if !defined $disk; # Validate the disk. $disk_href = $dbh->selectrow_hashref("SELECT id, uri_name, volume, COALESCE(title, 'MAG Disk') AS title, COALESCE(TO_CHAR(issue_date, 'YYYY-MM'), '19xx') AS issue_date, COALESCE(TO_CHAR(issue_date, 'Mon YYYY'), '19xx') AS issue_date_text FROM disks WHERE uri_name = ?", undef, $disk); $m->clear_and_abort(404) if !defined $disk_href; # A request for the disk's URI name followed by ".png" or ".adf" in the # root of a disk is a special case. We're going on the (hopefully safe) # assumption that we'll never have disks that have real files with these # names. if (scalar @path == 1) { if ($path[0] eq "$disk_href->{uri_name}.png") { $special = 'send-disk-scan'; } elsif ($path[0] eq "$disk_href->{uri_name}.adf") { $special = 'send-disk-dump'; } } return if defined $special; # Validate the path, if any. The idea is to check the database for each # component of the path from left to right to make sure each has the # correct disk ID, parent ID, and name. The first component should not # have a parent ID; the rest should have a parent ID equal to the ID of the # component that preceeded it. If we ever fail to retrieve any of the # parts of the path, then the whole path is invalid, and we throw a 404. my $parent_id; for my $object_name (@path) { my $parent_clause = defined $parent_id ? "= $parent_id" : 'IS NULL'; $object_href = $dbh->selectrow_hashref(" SELECT id, name, dir, type, mimetype FROM filesystem WHERE disk_id = ? AND parent_id $parent_clause AND name = ? ", undef, ($disk_href->{id}, $object_name)); $m->clear_and_abort(404) if !defined $object_href; $parent_id = $object_href->{id}; } <%method navigation> <%doc> The navigation block is simply a list of all years we have disks for. <%init> my $years_aref = $dbh->selectall_arrayref(" SELECT DISTINCT DATE_PART('year', issue_date) AS year, COUNT(\*) FROM disks GROUP BY year ORDER BY year"); my $total_disks = sum map { $_->[1] } @$years_aref;
DiskMAG Index
<%method page-head> <%doc> The page header also operates as breadcrumbs, with links to each part of the current path. <%init> my $pagehead = 'All DiskMAGs'; if (defined (my $year = $m->request_args->{year})) { if ($year =~ /^(19[89]\d|unknown)$/) { $pagehead = ($year eq 'unknown' ? 'Undated' : $year) . ' DiskMAGs'; } } if (defined $disk) { my $dir_depth = scalar @path; $dir_depth-- if !$object_href->{dir}; $pagehead = '' . encode_entities($disk_href->{title}) . ' (' . $disk_href->{issue_date_text} . ') : '; for (my $i = 0; $i <= $dir_depth; $i++) { my $uri = '../' x ($dir_depth - $i - 1) || './'; # If this is the last element in the path and it's not a directory, # then we link to the filename. if ($i == $#path && !$object_href->{dir}) { $uri = $m->interp->apply_escapes($path[$i], 'u'); } $pagehead .= '' . encode_entities($path[$i]) . ' '; $pagehead .= '/ ' if $i != $dir_depth; } } <% $pagehead %> <%method title> <%init> # The title is the same as the page header, minus the anchor tags, and # with some changes to the spacing in different parts of the path. my $title = $m->scomp('SELF:page-head'); $title =~ s{| [^>]*?>)}{}g; $title =~ s{ (:|/) }{$1}g; <% $title %> <%method show-disk-index> <%doc> This method shows an index of all the disks that are available. An optional year can be supplied to limit the output. <%args> $year => undef <%init> # This is a user-inputted value, so sanitize it. $year = undef if $year !~ /^(19[89]\d|unknown)$/; my $where_clause; if ($year eq 'unknown') { $where_clause = 'WHERE issue_date IS NULL'; } elsif (defined $year) { $where_clause = "WHERE DATE_PART('year', issue_date) = $year"; } # Retrieving multiple rows as an array of hash references preserves ORDER # BY order and allows for using the columns in each row by their names. my $disks_aref = $dbh->selectall_arrayref(" SELECT uri_name, date_exact, COALESCE(title, 'MAG Disk') AS title, TO_CHAR(issue_date, 'Month YYYY') AS issue_date_text FROM disks $where_clause ORDER BY issue_date, uri_name ", { Slice => {} });

Download clrmamepro DAT for all DiskMAGs

% my $i = 1; % for my $disk_href (@$disks_aref) { % my $cell_class = 'class="mark"' if $i++ % 2; % }
Date Name
> > % if (defined $disk_href->{issue_date_text}) { <% $disk_href->{issue_date_text} %> <% $disk_href->{date_exact} ? undef : '(?)' %> % } else { Unknown % } > <% $disk_href->{title} | h %>
<%method show-dir> <%doc> This method shows the contents of a directory on a disk. By default it does not list Amiga icons (files ending in ".info.") It also shows thumbnails of images in the directory and shows the contents of certain small text files (readmes, etc.), so that users can more easily discover all of our delicious content. <%args> $icons => undef # Show Amiga icons (.info files?) <%init> # This is a user-inputted value, so sanitize it. $icons = 1 if $icons; # The root directory on a disk will not have a parent ID. my $dir_id = $object_href->{id}; my $parent_clause = defined $dir_id ? "= $dir_id" : 'IS NULL'; # Retrieve the contents of the requested directory on the requested disk. my $contents_aref = $dbh->selectall_arrayref(" SELECT id, disk_id, parent_id, name, dir, type, longtype, LENGTH(contents) AS size, TO_CHAR(time_stamp, 'YYYY-MM-DD') AS time_stamp FROM filesystem WHERE disk_id = ? AND parent_id $parent_clause ORDER BY dir DESC, UPPER(name) ", { Slice => {} }, $disk_href->{id}); # Remove icons from the results if they aren't wanted. if (!$icons) { $contents_aref = [ grep { $_->{type} ne 'icon' } @$contents_aref ]; } # Retrieve information about images found in this directory. my $images_aref = $dbh->selectall_arrayref(" SELECT fs.name, i.th_width, i.th_height, i.conversion FROM filesystem AS fs, images AS i WHERE fs.id = i.id AND fs.disk_id = ? AND parent_id $parent_clause ORDER BY fs.name ", { Slice => {} }, $disk_href->{id}); # Retrieve certain text files for immediate display. my $texts_aref = $dbh->selectall_arrayref(" SELECT name, contents FROM filesystem WHERE disk_id = ? AND parent_id $parent_clause AND type = 'text' AND (name ILIKE '%read%me%' OR name ILIKE '%mag%' OR name ILIKE '%content%' OR name ILIKE '%prezcli%' OR name ILIKE '%poster%' OR name ILIKE '%library%' OR name ILIKE '%bbs%') AND LENGTH(contents) < 10240 ORDER BY name ", { Slice => {} }, $disk_href->{id}); % # Show the image thumbnails, if there are any. % if (scalar @$images_aref) {
% } <%doc> A method GET form will put the argument in the URI, allowing the user to bookmark and/or construct URIs as he pleases.

Options: onclick="this.form.submit();" /> % # If this is the root directory, show links for the disk scan and dump. % if (!defined $dir_id) { · Disk Scan · Download ADF % }

% my $i = 0; % for my $entry (@$contents_aref) { % my $cell_class = 'class="mark"' if $i++ % 2; % # Add slashes to directories; preserve state of "show icons" toggle. % my $href_trailer = $entry->{dir} ? '/' : ''; % $href_trailer .= '?icons=1' if ($entry->{dir} && $icons); % }
Name Size Date Type
../
> % if ($entry->{type} =~ /^(text|image)$/) { % } elsif ($entry->{dir}) { % } > <% $entry->{name} | h %><% $entry->{dir} ? '/' : '' %> ><% $entry->{size} %> ><% $entry->{time_stamp} %> > % if ($entry->{type} =~ /^(text|image)$/) { <% ucfirst($entry->{type}) %> [Original] % }
% # Show the retrieved texts, if there are any. % for my $file (@$texts_aref) {

<% $file->{name} | h %>

<% encode_entities($file->{contents}) %>
% } <%method handle-file> <%doc> This method handles requests for files in the database. The only types of files that receive special treatment are text and images. The rest we send as-is. See the handle-file-text and handle-file-image methods for further notes. <%args> $noconvert => undef # Send the original file instead of the converted version? <%init> # This is a user-inputted value, so sanitize it. $noconvert = 1 if $noconvert; # Handle text and image files specially if the original wasn't requested. if ($object_href->{type} =~ /^(text|image)$/ && !$noconvert) { $m->comp("SELF:handle-file-$object_href->{type}", %ARGS); return; } # If we got this far, we're just sending the requested file. $m->comp('SELF:send-file'); <%method handle-file-text> <%doc> Texts are either wrapped in our site's header/navigation/footer or sent as content type text/plain, depending on whether the original version was requested or not. The difference is: /diskmags/Disk_1989-03/README Show as site content /diskmags/Disk_1989-03/README?noconvert=1 Sent as text/plain There are also AmigaGuide documents in the database. AmigaGuide was an early plain text, hypertext-like document format for the Amiga. We parse those files and make them useful here in the modern HTML world. <%init> my ($contents) = $dbh->selectrow_array('SELECT contents FROM filesystem WHERE id = ?', undef, $object_href->{id}); if ($object_href->{name} =~ /\.guide$/i) { $m->comp('SELF:parse-amigaguide', contents => $contents); } else { print '
' . encode_entities($contents) . '
'; } <%method handle-file-image> <%doc> Images get more attention. The idea here is to make "normal" URIs (i.e. URIs without arguments) show what a visitor would most likely want to so. Same as text, they are either displayed inline in an HTML page or sent with an appropriate content type. Images in the filesystem are also stored in the images table in both full size and thumbnail versions, and Amiga formats have been converted to PNG in that table. Normally we send the file in the images table so that modern peoples can view the Amiga format images in their web browser rather than having to convert them themselves (i.e. more users are likely to find our tasty web content.) We also permit the user to download the original, unconverted files if they really want to. Full-size image shown wrapped in our site's layout: /diskmags/Disk_1989-05/DRAIN Same, but with thumbnail (mostly useless, but handled anyway): /diskmags/Disk_1989-05/DRAIN?thumb=1 Full-size image sent as image/* (use this in an tag): /diskmags/Disk_1989-05/DRAIN?display=1 Thumbnail sent as image/* (also for tags) /diskmags/Disk_1989-05/DRAIN?display=1&thumb=1 Send original, non-converted, Amiga-format image /diskmags/Disk_1989-05/DRAIN?noconvert=1 Any other combination of arguments is most likely useless. <%args> $display => undef # Send the converted image instead of displaying it inline? $thumb => undef # Show the thumbnail version of the image? $autoaspect => 1 # Automatically correct Amiga aspect ratio? $aspect => undef # Correct Amiga aspect ratio (if autoaspect is false)? <%init> # These are user-inputted values, so sanitize them. for my $ref (\$display, \$thumb, \$autoaspect, \$aspect) { $$ref = 1 if $$ref; } # Grab the appropriate image from the images table. The table columns # we want depend on if we want the full size image or the thumbnail. my $table_columns = $thumb ? 'thumbnail AS contents, th_width AS width, th_height AS height' : 'contents, width, height'; my $image_href = $dbh->selectrow_hashref("SELECT $table_columns, conversion FROM images WHERE id = ?", undef, $object_href->{id}); if (!$display) { $m->comp('SELF:show-image-page', %$image_href, name => $object_href->{name}, thumb => $thumb, autoaspect => $autoaspect, aspect => $aspect); return; } $m->comp('SELF:send-file', contents => $image_href->{contents}); <%method parse-amigaguide> <%args> $contents <%init> # encode_entities converts double quotes to ". Convert them back to # simplify the regular expressions that follow. (We can't just use # encode_entities after the regular expressions because it will destroy # the HTML we introduce.) $contents = encode_entities($contents); $contents =~ s/"/"/g; # This is a braindead AmigaGuide to HTMLizer. It simply converts # AmigaGuide nodes to IDed HTML spans. AmigaGuide links to those nodes # are converted to HTML links. There are some things we don't bother to # handle, like links that spawn executables or show images. $contents =~ s|\@\{"(.+?)",?\s+link\s+"?(.+?)"?\}|$1|gi; $contents =~ s|^\@node\s+"?(.+?)"?(?:\s+"(.+)")?$|$2|gim; $contents =~ s|^\@toc\s+"?(.+?)"?$|Table of Contents|gim; $contents =~ s|^\@database.*$||gim; $contents =~ s|\s+\@endnode\s*|\n\n
\n|gis; # Text styles. $contents =~ s|\@\{b\}||gi; # bold on $contents =~ s|\@\{ub\}||gi; # bold off $contents =~ s|\@\{i\}||gi; # italics on $contents =~ s|\@\{ui\}||gi; # italics off $contents =~ s|\@\{u\}||gi; # underline on $contents =~ s|\@\{uu\}||gi; # underline off
<% $contents %>
<%method show-image-tag> <%doc> This method produces an tag for an image. Amiga images are often doubled in height to account for the non-square pixels in the Amiga's low resolution screenmodes. If the image we're showing is a conversion of an Amiga-format image, then we guess if the height should be corrected based on the image's height-to-width ratio. This automatic aspect correction can be overridden by way of the $autoaspect and $aspect arguments. <%args> $name $path => './' $width => undef $height => undef $conversion => undef # Is this image a converstion of an Amiga format? $thumb => undef # Show the thumbnail version? $autoaspect => 1 # Automatically correct Amiga image aspect ratio? $aspect => undef # If autoaspect is false, correct aspect ratio? <%init> if ($conversion && defined $width && defined $height) { if ( $autoaspect && $height > $width && int($height / 2) <= $width ) { $aspect = 1; } if ($aspect) { $height = int($height / 2 * 1.2); } } $path = join '/', map { $m->interp->apply_escapes($_, 'u') } split /\//, $path; <% $name | h %> <% defined $height ? qq{height="$height"} : '' %> src="<% $path %>/<% $name | u %>?display=1<% $thumb ? '&thumb=1' : '' %>" /> <%method show-image-page> <%doc> Generates the HTML page for showing full-size images. <%args> $name $width => undef $height => undef $conversion => undef # Is this image a converstion of an Amiga format? $thumb => undef # Show the thumbnail version? $autoaspect => 1 # Automatically correct Amiga image aspect ratio? $aspect => undef # If autoaspect is false, correct aspect ratio? <%init> if ( $conversion && defined $width && defined $height && $autoaspect && $height > $width && int($height / 2) <= $width ) { $aspect = 1; } % if ($conversion) {

Options: onclick="this.form.submit();" />

% }
<% $m->comp('SELF:show-image-tag', name => $name, width => $width, height => $height, conversion => $conversion, thumb => $thumb, autoaspect => $autoaspect, aspect => $aspect) %>
<%method send-file> <%doc> Sends a file to the user, adding appropriate HTTP headers in the process. Determining the content type automagically if not supplied. <%args> $contents => undef $mimetype => undef $filename => undef <%init> # If $contents were not passed, then assume that we're sending the current # requested object. if (!defined $contents) { if ($object_href->{dir}) { die "send-file can't handle a directory"; } ($contents) = $dbh->selectrow_array('SELECT contents FROM filesystem WHERE id = ?', undef, $object_href->{id}); ($mimetype, $filename) = ($object_href->{mimetype}, $object_href->{name}); } if (!defined $mimetype) { $mimetype = File::MMagic->new->checktype_contents($contents); } if (!defined $filename) { $filename = $object_href->{name}; } $m->clear_buffer; $r->err_headers_out->{'Content-Disposition'} = qq{filename="$filename"}; $r->err_headers_out->{'Content-Length'} = length $contents; $r->err_headers_out->{'Cache-Control'} = 'max-age=3600, must-revalidate'; $r->content_type($mimetype); $m->print($contents); $m->abort; <%method send-disk-scan> <%doc> Used to send the scanned image of the disk. <%init> my ($contents) = $dbh->selectrow_array('SELECT image FROM disks WHERE id = ?', undef, $disk_href->{id}); $m->comp('SELF:send-file', contents => $contents, filename => "$disk_href->{uri_name}.png"); <%method send-disk-dump> <%doc> Sends an Amiga ADF (floppy disk image), with appropriate TOSEC name. <%init> my $tosec_name = $m->comp('SELF:make-tosec-name'); my ($contents) = $dbh->selectrow_array('SELECT adf FROM disks WHERE id = ?', undef, $disk_href->{id}); # ADFs get misidentified as text by File::MMagic due to the three-byte # "DOS" marker at the beginning, so supply the mimetype explicitly. $m->comp('SELF:send-file', contents => $contents, mimetype => 'application/octet-stream', filename => $tosec_name); <%method make-tosec-name> <%doc> Creates a TOSEC-compliant name for the disk. <%init> my $tosec_name = 'MAG ' if $disk_href->{title} !~ /^MAG/; $tosec_name .= "$disk_href->{title} ($disk_href->{issue_date})" . '(Memphis Amiga Group)'; $tosec_name .= '[!]' if $disk_href->{good_dump}; $tosec_name .= '.adf'; return $tosec_name;