<: BEGIN { $header{Content_Type} = 'text/html; charset=UTF-8'; } :> SVG-dump upload

Resultaat

<: use CGI (); use XML::LibXML (); use HTML::Entities qw(encode_entities); use Encode qw(encode); use POSIX qw(strftime); use DBIx::Simple(); my $meta = "Je moet bij de Document Metadata title en creator invullen."; sub enc ($) { encode 'UTF-8', shift } sub process_upload { local $/; my $svgfile = CGI->new->param('svgfile') or return "Geen bestand ontvangen (err=1)"; fileno($svgfile) or return "Geen bestand ontvangen (err=2)"; my $size = -s $svgfile or return "Ontvangen bestand is leeg (err=3)"; $size < 1.5 * 1024 * 1024 or return "Ontvangen bestand is te groot (err=4)"; my $svg = readline $svgfile or return "Bestand uitlezen is mislukt (err=5)"; $svg =~ /^<\?xml/ or return "Bestand is geen XML-bestand (err=6)"; my $parser = XML::LibXML->new; my $document = $parser->parse_string($svg) or return "XML parsen is mislukt (err=7)"; (my $root = $document->documentElement)->localname eq 'svg' or return "Bestand is geen SVG-bestand (err=8)"; my $title = $root->findvalue('//cc:Work/dc:title') or return "Geen title ingevuld! $meta (err=9)"; my $creator = $root->findvalue('//cc:Work/dc:creator//dc:title') or return "Geen creator ingevuld! $meta (err=10)"; my $description = $root->findvalue('//cc:Work/dc:description'); my $db = DBIx::Simple->new('dbi:SQLite:dump/dump.db', undef, undef, {RaiseError => 1}); my $mintime = strftime("%Y-%m-%d %H:%M:%S", localtime(time() - 5*60)); $db->query(' SELECT 1 FROM svgfiles WHERE creator = ? AND title = ? AND description = ? AND datetime > ?', enc $creator, enc $title, enc $description, $mintime )->list and return "Je mag niet binnen 5 minuten hetzelfde bestand uploaden (err=14)"; my $datetime = strftime("%Y-%m-%d %H:%M:%S", localtime); (my $fn = $datetime) =~ s/ /T/; $fn .= "_"; $fn .= $_ % 2 ? chr(0x61 + int rand 26) : chr(0x30 + int rand 10) for 1..6; $fn .= ".svg"; open my $fh, "|-", "gzip --best > dump/$fn.gz" or return "Kan bestand niet wegschrijven (err=11, $!)"; print {$fh} $svg or return "Kan bestand niet wegschrijven (err=12, $!)"; close $fh or return "Kan bestand niet wegschrijven (err=13, $!)"; my $url = "http://svg.tnx.nl/dump/$fn"; $db->query(' INSERT OR REPLACE INTO svgfiles (fn, datetime, creator, title, description) VALUES (??)', $fn, $datetime, enc $creator, enc $title, enc $description ); return sprintf( qq[Upload succesvol. Bedankt voor %s, %s! De URL is $url.
([url=$url]svg[/url])], enc encode_entities($title), enc encode_entities($creator) ); } print "

", process_upload(), "

"; :>

Terug