/[suikacvs]/www/test/uri/data/test.cgi
Suika

Contents of /www/test/uri/data/test.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Sun Jun 1 08:55:24 2008 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
New

1 #!/usr/bin/perl
2 use strict;
3
4 my $file_name = 'data-uris.txt';
5
6 my @item;
7 {
8 open my $file, '<', $file_name;
9 local $/ = undef;
10 @item = split /\n\n#/, <$file>;
11 }
12
13 sub htescape ($) {
14 my $s = shift;
15 $s =~ s/&/&amp;/g;
16 $s =~ s/</&lt;/g;
17 $s =~ s/"/&quot;/g;
18 return $s;
19 } # htescape
20
21 sub get_id ($) {
22 my $s = shift;
23 $s =~ s/([^0-9A-Za-z-])/sprintf '_%08X', ord $1/ge;
24 return $s;
25 } # get_id
26
27 print qq[Content-Type: text/html; charset=utf-8
28
29 <!DOCTYPE HTML>
30 <html lang=en>
31 <title>data: URIs</title>
32 <style>
33 .note {
34
35 }
36 .item {
37 margin: 1em;
38 padding: 0.2em 0.7em;
39 background-color: #F0F8FC;
40 color: black;
41 }
42 </style>];
43
44 for (@item) {
45 s/^#//;
46 my %prop;
47 for (split /\n#/, $_) {
48 if (s/^(data|note|conforming|non-conforming)(?>\n|\z)//s) {
49 $prop{$1} = $_;
50 }
51 }
52
53 my $id = htescape (get_id ($prop{data}));
54 my $euri = htescape ($prop{data});
55 print qq[<div class=item id=$id><p>URI: &lt;<a href="$euri">$euri</a>&gt;];
56 for (qw/note conforming non-conforming/) {
57 next unless defined $prop{$_};
58 print qq[<p>];
59 print qq[<strong>Conforming</strong>: ] if $_ eq 'conforming';
60 print qq[<strong>Non-conforming</strong>: ] if $_ eq 'non-conforming';
61 my $v = htescape ($prop{$_});
62 $v =~ s[&lt;([^>]+)>][&lt;<a href="$1">$1</a>&gt;]g;
63 print qq[<span class=note>] . $v . qq[</span>];
64 }
65 print qq[</div>];
66 }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24