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