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