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 Message'},
  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'},
  dvi	=> {mediatype => 'application/x-dvi',	description => 'DVI'},
  tex	=> {mediatype => 'application/x-tex',	description => 'TeX'},
  bmp	=> {mediatype => 'image/x-bmp',	description => 'Windows Bitmap'},
  ico	=> {mediatype => 'image/x-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 => 'WAVE audio'},
  mp3	=> {mediatype => 'audio/mpeg',	description => 'MP3'},
  pl	=> {mediatype => 'application/x-perl',	description => 'Perl Script'},
  pm	=> {mediatype => 'application/x-perl',	description => 'Perl Module'},
  rdf   => {mediatype => 'application/rdf+xml', description => 'RDF/XML'},
  rss   => {mediatype => 'application/rdf+xml', description => 'RSS'},
);

my %encode = (
  gz	=> {description => 'GNU zip'},
  lzh	=> {description => 'LHA'},
  zip	=> {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'},
  jis	=> {charset => '',              description => '7bit ISO/IEC 2022'},
  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 = '<a href="'.$file.'">'.$file.'</a> (';
for my $filea (@items) {
  $ret .= '<a href="'.$$filea{name}.'" title="('.$$filea{type}.
          ($$filea{encode}? ' + '.$$filea{encode}:'').')"'.
          ($$filea{mediatype}? ' type="'.$$filea{mediatype}.'"':'').
          ($$filea{charset}? ' charset="'.$$filea{charset}.'"':'').
          ($$filea{lang}? ' hreflang="'.$$filea{lang}.'"':'').
          '>'.$$filea{type}.
          ($$filea{encode}? ' + '.$$filea{encode}:'').'</a> ';
  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.'ko'.($d != 1? 's':'');
  } elsif ($$filea{size} < (1024*1024*1024)) {
    my $d = sprintf('%.2f', ($$filea{size}/1024)/1024);
    $ret .= $d.'Mo'.($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:

  <a href="slide">slide</a> 
  (<a href="slide.ja.pdf.gz" title="(PDF + GNU zip)" type="application/pdf" 
      hreflang="ja">PDF + GNU zip</a> 269.21kilooctets; 
   <a href="slide.ja.ppt.gz" title="(Microsoft PowerPoint + GNU zip)" 
      type="application/vnd-ms-powerpoint" hreflang="ja">
      Microsoft PowerPoint + GNU zip</a> 187.32kilooctets)

(linebreaks are putted by author for readability, not by cneg.pl.)

=head1 LICENSE

Copyright 2001-2003 Wakaba <w@suika.fam.cx>.

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.

=cut