use strict;
my $file = $main::ARGV[0];
$file =~ tr#\\#/#;
$file =~ s#\.[^/]+$##;
my $dir = $file;
$dir =~ s#[^/]+$##;
$file =~ s#^[\x00-\xff]*?/([^/]+)$#$1#;
opendir DIR, $dir;
my @files = sort(grep(/^$file/, readdir(DIR)));
close DIR;
my %type = (
txt => {mediatype => 'text/plain', description => 'plain-text'},
'822' => {mediatype => 'message/rfc822', description => 'IETF RFC 822'},
htm => {mediatype => 'text/html', description => 'HTML'},
html => {mediatype => 'text/html', description => 'HTML'},
xml => {mediatype => 'application/xml', description => 'XML'},
css => {mediatype => 'text/css', description => 'CSS'},
pdf => {mediatype => 'application/pdf', description => 'PDF'},
doc => {mediatype => 'application/msword', description => 'Microsoft Word'},
xls => {mediatype => 'application/vnd.ms-excel', description => 'Microsoft Excel'},
ppt => {mediatype => 'application/vnd-ms-powerpoint', description => 'Microsoft PowerPoint'},
bmp => {mediatype => 'image/x-windows-bitmap', description => 'Windows Bitmap'},
ico => {mediatype => 'image/x-windows-icon', description => 'Windows Icon'},
png => {mediatype => 'image/png', description => 'PNG'},
mng => {mediatype => 'video/x-mng', description => 'MNG'},
jpg => {mediatype => 'image/jpeg', description => 'JPEG(JFIF)'},
jpeg => {mediatype => 'image/jpeg', description => 'JPEG(JFIF)'},
mpg => {mediatype => 'video/mpeg', description => 'MPEG'},
mpeg => {mediatype => 'video/mpeg', description => 'MPEG'},
cwj => {mediatype => 'application/x-claris-works', description => 'Claris Works 4.0 (Macintosh)'},
wav => {mediatype => 'audio/x-wav', description => 'WAV audio'},
mp3 => {mediatype => 'audio/mpeg', description => 'MP3'},
pl => {mediatype => 'application/x-perl', description => 'Perl Script'},
pm => {mediatype => 'application/x-perl', description => 'Perl Module'},
);
my %encode = (
gz => {description => 'GNU zip'},
lzh => {description => 'LHA'},
lzh => {description => 'ZIP'},
sj3 => {charset => 'shift_jisx0213', description => 'Shift_JISX0213'},
sjis => {charset => 'shift_jis', description => 'Shift_JIS'},
euc => {charset => 'euc-jp', description => 'EUC-JP'},
ej3 => {charset => 'euc-jisx0213', description => 'EUC-JISX0213'},
u8 => {charset => 'utf-8', description => 'UTF-8'},
);
my %lang = (
en => {lang => 'en'},
ja => {lang => 'ja'},
zh => {lang => 'zh'},
);
my @items;
for my $f (@files) {
my %file;
$file{name} = $f;
$f =~ s{\.([^.]+)}{
$file{type} = $type{$1}->{description} if $type{$1}->{description};
$file{mediatype} = $type{$1}->{mediatype} if $type{$1}->{mediatype};
$file{encode} = $encode{$1}->{description} if $encode{$1}->{description};
$file{charset} = $encode{$1}->{charset} if $encode{$1}->{charset};
$file{lang} = $lang{$1}->{lang} if !$file{lang} && $lang{$1}->{lang};
}gesx;
$file{size} = (-s $dir.$file{name});
push @items, \%file;
}
my $ret;
$ret = ''.$file.' (';
for my $filea (@items) {
$ret .= ''.$$filea{type}.
($$filea{encode}? ' + '.$$filea{encode}:'').' ';
if ($$filea{size} < 1024) {
$ret .= $$filea{size}.'octet'.($$filea{size} != 1? 's':'');
} elsif ($$filea{size} < (1024*1024)) {
my $d = sprintf('%.2f', $$filea{size}/1024);
$ret .= $d.'kilooctet'.($d != 1? 's':'');
} elsif ($$filea{size} < (1024*1024*1024)) {
my $d = sprintf('%.2f', ($$filea{size}/1024)/1024);
$ret .= $d.'Moctet'.($d != 1? 's':'');
}
$ret .= '; ';
}
$ret =~ s/; $//;
$ret .= ')';
use Win32::Clipboard;
Win32::Clipboard->new($ret);
=head1 NAME
cneg.pl -- Content negotiation linking
=head1 DESCRIPTION
Create html fragment of links for one resource with
multiple formats.
=head1 EXAMPLE
For example, there are two files:
slide.ja.doc.gz
slide.ja.pdf.gz
When you run
$ cneg.pl slide.ja.doc.gz
or
$ cneg.pl slide.ja.pdf.gz
cneg.pl copies to clipboard the string:
slide
(PDF + GNU zip 269.21kilooctets;
Microsoft PowerPoint + GNU zip 187.32kilooctets)
(linebreaks are putted by author for readability, not by cneg.pl.)
=head1 LICENSE
Copyright 2001,2002 wakaba .
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; see the file COPYING. If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.
=head1 CHANGE
See ChangeLog.
=cut