www/tinytools/cneg.pl


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 = '<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.'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:

  <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,2002 wakaba <wakaba@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.

=head1 CHANGE

See ChangeLog.

=cut
1	wakaba	1.1
2			use strict;
3			my $file = $main::ARGV[0];
4			$file =~ tr#\\#/#;
5			$file =~ s#\.[^/]+$##;
6
7			my $dir = $file;
8			$dir =~ s#[^/]+$##;
9
10			$file =~ s#^[\x00-\xff]*?/([^/]+)$#$1#;
11
12			opendir DIR, $dir;
13			my @files = sort(grep(/^$file/, readdir(DIR)));
14			close DIR;
15
16			my %type = (
17			txt => {mediatype => 'text/plain', description => 'plain-text'},
18			'822' => {mediatype => 'message/rfc822', description => 'IETF RFC 822'},
19			htm => {mediatype => 'text/html', description => 'HTML'},
20			html => {mediatype => 'text/html', description => 'HTML'},
21			xml => {mediatype => 'application/xml', description => 'XML'},
22			css => {mediatype => 'text/css', description => 'CSS'},
23			pdf => {mediatype => 'application/pdf', description => 'PDF'},
24			doc => {mediatype => 'application/msword', description => 'Microsoft Word'},
25			xls => {mediatype => 'application/vnd.ms-excel', description => 'Microsoft Excel'},
26			ppt => {mediatype => 'application/vnd-ms-powerpoint', description => 'Microsoft PowerPoint'},
27			bmp => {mediatype => 'image/x-windows-bitmap', description => 'Windows Bitmap'},
28			ico => {mediatype => 'image/x-windows-icon', description => 'Windows Icon'},
29			png => {mediatype => 'image/png', description => 'PNG'},
30			mng => {mediatype => 'video/x-mng', description => 'MNG'},
31			jpg => {mediatype => 'image/jpeg', description => 'JPEG(JFIF)'},
32			jpeg => {mediatype => 'image/jpeg', description => 'JPEG(JFIF)'},
33			mpg => {mediatype => 'video/mpeg', description => 'MPEG'},
34			mpeg => {mediatype => 'video/mpeg', description => 'MPEG'},
35			cwj => {mediatype => 'application/x-claris-works', description => 'Claris Works 4.0 (Macintosh)'},
36			wav => {mediatype => 'audio/x-wav', description => 'WAV audio'},
37			mp3 => {mediatype => 'audio/mpeg', description => 'MP3'},
38			pl => {mediatype => 'application/x-perl', description => 'Perl Script'},
39			pm => {mediatype => 'application/x-perl', description => 'Perl Module'},
40			);
41
42			my %encode = (
43			gz => {description => 'GNU zip'},
44			lzh => {description => 'LHA'},
45			lzh => {description => 'ZIP'},
46			sj3 => {charset => 'shift_jisx0213', description => 'Shift_JISX0213'},
47			sjis => {charset => 'shift_jis', description => 'Shift_JIS'},
48			euc => {charset => 'euc-jp', description => 'EUC-JP'},
49			ej3 => {charset => 'euc-jisx0213', description => 'EUC-JISX0213'},
50			u8 => {charset => 'utf-8', description => 'UTF-8'},
51			);
52
53			my %lang = (
54			en => {lang => 'en'},
55			ja => {lang => 'ja'},
56			zh => {lang => 'zh'},
57			);
58
59			my @items;
60			for my $f (@files) {
61			my %file;
62			$file{name} = $f;
63			$f =~ s{\.([^.]+)}{
64			$file{type} = $type{$1}->{description} if $type{$1}->{description};
65			$file{mediatype} = $type{$1}->{mediatype} if $type{$1}->{mediatype};
66			$file{encode} = $encode{$1}->{description} if $encode{$1}->{description};
67			$file{charset} = $encode{$1}->{charset} if $encode{$1}->{charset};
68			$file{lang} = $lang{$1}->{lang} if !$file{lang} && $lang{$1}->{lang};
69			}gesx;
70			$file{size} = (-s $dir.$file{name});
71			push @items, \%file;
72			}
73
74			my $ret;
75			$ret = '<a href="'.$file.'">'.$file.'</a> (';
76			for my $filea (@items) {
77			$ret .= '<a href="'.$$filea{name}.'" title="('.$$filea{type}.
78			($$filea{encode}? ' + '.$$filea{encode}:'').')"'.
79			($$filea{mediatype}? ' type="'.$$filea{mediatype}.'"':'').
80			($$filea{charset}? ' charset="'.$$filea{charset}.'"':'').
81			($$filea{lang}? ' hreflang="'.$$filea{lang}.'"':'').
82			'>'.$$filea{type}.
83			($$filea{encode}? ' + '.$$filea{encode}:'').'</a> ';
84			if ($$filea{size} < 1024) {
85			$ret .= $$filea{size}.'octet'.($$filea{size} != 1? 's':'');
86			} elsif ($$filea{size} < (1024*1024)) {
87			my $d = sprintf('%.2f', $$filea{size}/1024);
88			$ret .= $d.'kilooctet'.($d != 1? 's':'');
89			} elsif ($$filea{size} < (102410241024)) {
90			my $d = sprintf('%.2f', ($$filea{size}/1024)/1024);
91			$ret .= $d.'Moctet'.($d != 1? 's':'');
92			}
93			$ret .= '; ';
94			}
95			$ret =~ s/; $//;
96			$ret .= ')';
97
98			use Win32::Clipboard;
99			Win32::Clipboard->new($ret);
100
101			=head1 NAME
102
103			cneg.pl -- Content negotiation linking
104
105			=head1 DESCRIPTION
106
107			Create html fragment of links for one resource with
108			multiple formats.
109
110			=head1 EXAMPLE
111
112			For example, there are two files:
113
114			slide.ja.doc.gz
115			slide.ja.pdf.gz
116
117			When you run
118
119			$ cneg.pl slide.ja.doc.gz
120
121			or
122
123			$ cneg.pl slide.ja.pdf.gz
124
125			cneg.pl copies to clipboard the string:
126
127			<a href="slide">slide</a>
128			(<a href="slide.ja.pdf.gz" title="(PDF + GNU zip)" type="application/pdf"
129			hreflang="ja">PDF + GNU zip</a> 269.21kilooctets;
130			<a href="slide.ja.ppt.gz" title="(Microsoft PowerPoint + GNU zip)"
131			type="application/vnd-ms-powerpoint" hreflang="ja">
132			Microsoft PowerPoint + GNU zip</a> 187.32kilooctets)
133
134			(linebreaks are putted by author for readability, not by cneg.pl.)
135
136			=head1 LICENSE
137
138			Copyright 2001,2002 wakaba <wakaba@suika.fam.cx>.
139
140			This program is free software; you can redistribute it and/or modify
141			it under the terms of the GNU General Public License as published by
142			the Free Software Foundation; either version 2 of the License, or
143			(at your option) any later version.
144
145			This program is distributed in the hope that it will be useful,
146			but WITHOUT ANY WARRANTY; without even the implied warranty of
147			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
148			GNU General Public License for more details.
149
150			You should have received a copy of the GNU General Public License
151			along with this program; see the file COPYING. If not, write to
152			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
153			Boston, MA 02111-1307, USA.
154
155			=head1 CHANGE
156
157			See ChangeLog.
158
159			=cut