/[suikacvs]/www/tinytools/cneg.pl
Suika

Contents of /www/tinytools/cneg.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Mon Feb 11 12:08:19 2002 UTC (22 years, 9 months ago) by wakaba
Branch: MAIN
File MIME type: text/plain
2002-02-11  wakaba <wakaba@suika.fam.cx>

	* cneg.pl: Add pod.

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} < (1024*1024*1024)) {
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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24