src/bundle.pl

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4 # Perl generator for the bundled files with UDPGate.
   5 # Copyright (C) 2004 Jan Kratochvil <project-udpgate@jankratochvil.net>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; exactly version 2 of June 1991 is required
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20
  21 use vars qw($VERSION);
  22 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
  23 use strict;
  24 use warnings;
  25
  26 use File::Basename;
  27 no utf8;
  28 use bytes;      # REQUIRED
  29
  30
  31 print <<"EOH";
  32 /* AUTOGENERATED FILE! DO NOT EDIT!
  33  * Bundled files with UDPGate.
  34  */
  35
  36
  37 #include "config.h"
  38
  39 #include <glib/ghash.h>
  40
  41 #include "bundle.h"     /* self */
  42
  43
  44 GHashTable *bundle_hash_new(void)
  45 {
  46 static GHashTable *hash;
  47 /* Prefixed 32-bit network byte order file length. */
  48 EOH
  49 my @files;
  50 for my $pathname (@ARGV) {
  51         local *F;
  52         open F,$pathname or die "Cannot open $pathname: $!";
  53         local $/=undef();
  54         my $F=<F>;
  55         close F or warn "Cannot close $pathname: $!";
  56         my $filename=basename $pathname;
  57         (my $filename_sym=$filename)=~tr/a-zA-Z/_/c;
  58         $filename_sym=~s/^_*//; # Prevent conflict with system internal symbols.
  59         push @files,{
  60                         "filename"    =>$filename,
  61                         "filename_sym"=>$filename_sym,
  62                         };
  63         # Do not: pack("N",length($F)).$F
  64         # as there would be utf8 encoding hassle.
  65         $F=pack("Na*",length($F),$F);   # Prefix 32-bit network byte order file length.
  66         my $Fout=unpack "H*",$F;
  67         $Fout=~s/../0x$&,/g;
  68         $Fout=~s/(?:.....){1,16}/\t\t$&\n/g;
  69         $Fout=~s/,\n$//;
  70         print <<"EOH";
  71 static const guint8 ${filename_sym}_data[]={
  72 $Fout
  73                 };
  74 EOH
  75         }
  76 print <<"EOH";
  77
  78         if (!hash) {
  79                 hash=g_hash_table_new(g_str_hash,g_str_equal);
  80 EOH
  81         for (@files) {
  82                 print "\t\tg_hash_table_insert(hash,\"".$_->{"filename"}."\",(gpointer)".$_->{"filename_sym"}."_data);\n";
  83                 }
  84 print <<"EOH";
  85                 }
  86         return hash;
  87 }
  88
  89 /* EOF */
  90 EOH