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
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