scripts/mkderivedparameters.pl

   1 #!/usr/bin/env perl
   2
   3 require "readvaluesfile.pl";
   4
   5 use Getopt::Std;
   6 getopts('chspi:');
   7
   8 %no_xname = (RELATED=>1,RANGE=>1,RSVP=>1,XLICERRORTYPE=>1,XLICCOMPARETYPE=>1);
   9
  10 %params = read_parameters_file($ARGV[0]);
  11
  12
  13 # Write the file inline by copying everything before a demarcation
  14 # line, and putting the generated data after the demarcation
  15
  16 if ($opt_i) {
  17
  18   open(IN,$opt_i) || die "Can't open input file $opt_i";
  19
  20   while(<IN>){
  21     if (/<insert_code_here>/){
  22       $autogenMsg = "of section of machine generated code (mkderivedparameters.pl). Do not edit.";
  23       if($opt_p){
  24           $startComment = "#";
  25           $endComment = "";
  26       } else {
  27           $startComment = "/*";
  28           $endComment = " */";
  29       }
  30       print $startComment." START ".$autogenMsg.$endComment."\n\n";
  31
  32       insert_code();
  33
  34       print $startComment." END   ".$autogenMsg.$endComment."\n\n";
  35     } else {
  36       print;
  37    }
  38
  39   }
  40
  41 }
  42
  43 sub insert_code
  44 {
  45
  46 # Write parameter enumerations and datatypes
  47
  48 if($opt_h){
  49   my $enumConst = $params{'ANY'}->{"kindEnum"};
  50   print "typedef enum icalparameter_kind {\n    ICAL_ANY_PARAMETER = ".$enumConst.",\n";
  51   $enumVal = 1;
  52   foreach $param (sort keys %params) {
  53
  54     next if !$param;
  55
  56     next if $param eq 'NO' or $param eq 'ANY';
  57
  58     my $uc = join("",map {uc($_);}  split(/-/,$param));
  59
  60     $enumConst = $params{$param}->{"kindEnum"};
  61
  62     print "    ICAL_${uc}_PARAMETER = ".$enumConst.", \n";
  63
  64   }
  65   $enumConst = $params{'NO'}->{"kindEnum"};
  66   print "    ICAL_NO_PARAMETER = ".$enumConst."\n} icalparameter_kind;\n\n";
  67
  68   # Now create enumerations for parameter values
  69   $idx = 20000;
  70
  71   print "#define ICALPARAMETER_FIRST_ENUM $idx\n\n";
  72
  73   foreach $param (sort keys %params) {
  74
  75     next if !$param;
  76
  77     next if $param eq 'NO' or $param eq 'ANY';
  78
  79     my $type = $params{$param}->{"C"};
  80     my $ucv = join("",map {uc(lc($_));}  split(/-/,$param));
  81     my @enums = @{$params{$param}->{'enums'}};
  82
  83     if(@enums){
  84
  85       print "typedef enum $type {\n";
  86       my $first = 1;
  87
  88       unshift(@enums,"X");
  89
  90       push(@enums,"NONE");
  91
  92       foreach $e (@enums) {
  93         if (!$first){
  94           print ",\n";
  95         } else {
  96           $first = 0;
  97         }
  98
  99         my $uce = join("",map {uc(lc($_));}  split(/-/,$e));
 100
 101         print "    ICAL_${ucv}_${uce} = $idx";
 102
 103         $idx++;
 104       }
 105       $c_type =~ s/enum //;
 106
 107       print "\n} $type;\n\n";
 108     }
 109   }
 110
 111   print "#define ICALPARAMETER_LAST_ENUM $idx\n\n";
 112
 113 }
 114
 115 if ($opt_c){
 116
 117
 118   # Create the icalparameter_value to icalvalue_kind conversion table
 119   my $count = 0;
 120   my $out;
 121
 122   foreach $enum (@{$params{'VALUE'}->{'enums'}}){
 123     next if $enum eq 'NO' or $enum eq 'ERROR';
 124     $uc = join("",map {uc(lc($_));}  split(/-/,$enum));
 125     $out.="    {ICAL_VALUE_${uc},ICAL_${uc}_VALUE},\n";
 126     $count++;
 127   }
 128
 129   $count+=2;
 130   print "static const struct icalparameter_value_kind_map value_kind_map[$count] = {\n";
 131   print $out;
 132   print "    {ICAL_VALUE_X,ICAL_X_VALUE},\n";
 133   print "    {ICAL_VALUE_NONE,ICAL_NO_VALUE}\n};\n\n";
 134
 135   #Create the parameter Name map
 136
 137   $out="";
 138   $count=0;
 139   foreach $param (sort keys %params) {
 140
 141     next if !$param;
 142
 143     next if $param eq 'NO' or $param eq 'ANY';
 144
 145     my $lc = join("",map {lc($_);}  split(/-/,$param));
 146     my $uc = join("",map {uc(lc($_));}  split(/-/,$param));
 147
 148     $count++;
 149     $out.="    {ICAL_${uc}_PARAMETER,\"$param\"},\n";
 150
 151   }
 152   $count+=1;
 153   print "static const struct icalparameter_kind_map parameter_map[$count] = { \n";
 154   print $out;
 155   print "    { ICAL_NO_PARAMETER, \"\"}\n};\n\n";
 156
 157   # Create the parameter value map
 158   $out ="";
 159   $count=0;
 160   foreach $param (sort keys %params) {
 161
 162     next if !$param;
 163
 164     next if $param eq 'NO' or $param eq 'ANY';
 165
 166     my $type = $params{$param}->{"C"};
 167     my $uc = join("",map {uc(lc($_));}  split(/-/,$param));
 168     my @enums = @{$params{$param}->{'enums'}};
 169
 170     if(@enums){
 171
 172       foreach $e (@enums){
 173         my $uce = join("",map {uc(lc($_));}  split(/-/,$e));
 174
 175         $count++;
 176         $out.="    {ICAL_${uc}_PARAMETER,ICAL_${uc}_${uce},\"$e\"},\n";
 177       }
 178
 179     }
 180   }
 181
 182   $count+=3;
 183   print "static const struct icalparameter_map icalparameter_map[] = {\n";
 184   print "{ICAL_ANY_PARAMETER,0,\"\"},\n";
 185   print $out;
 186   print "    {ICAL_NO_PARAMETER,0,\"\"}};\n\n";
 187
 188 }
 189
 190 foreach $param  (sort keys %params){
 191
 192   next if $param eq 'NO' or $param eq 'ANY';
 193
 194   my $type = $params{$param}->{'C'};
 195
 196   my $ucf = join("",map {ucfirst(lc($_));}  split(/-/,$param));
 197
 198   my $lc = lc($ucf);
 199   my $uc = uc($lc);
 200
 201   my $charorenum;
 202   my $set_code;
 203   my $pointer_check;
 204   my $pointer_check_v;
 205   my $xrange;
 206
 207   if ($type=~/char/ ) {
 208
 209      $charorenum = "    icalerror_check_arg_rz( (param!=0), \"param\");\n    return param->string;";
 210
 211      $set_code = "((struct icalparameter_impl*)param)->string = icalmemory_strdup(v);";
 212
 213      $pointer_check = "icalerror_check_arg_rz( (v!=0),\"v\");";
 214      $pointer_check_v = "icalerror_check_arg_rv( (v!=0),\"v\");";
 215
 216   } else {
 217
 218     $xrange ="     if (param->string != 0){\n        return ICAL_${uc}_X;\n        }\n" if !exists $no_xname{$uc};
 219
 220     $charorenum= "icalerror_check_arg( (param!=0), \"param\");\n$xrange\nreturn ($type)(param->data);";
 221
 222     $pointer_check = "icalerror_check_arg_rz(v >= ICAL_${uc}_X,\"v\");\n    icalerror_check_arg_rz(v < ICAL_${uc}_NONE,\"v\");";
 223
 224     $pointer_check_v = "icalerror_check_arg_rv(v >= ICAL_${uc}_X,\"v\");\n    icalerror_check_arg_rv(v < ICAL_${uc}_NONE,\"v\");";
 225
 226      $set_code = "((struct icalparameter_impl*)param)->data = (int)v;";
 227
 228    }
 229
 230
 231
 232   if ($opt_c) {
 233
 234   print <<EOM;
 235 /* $param */
 236 icalparameter* icalparameter_new_${lc}($type v)
 237 {
 238    struct icalparameter_impl *impl;
 239    icalerror_clear_errno();
 240    $pointer_check
 241    impl = icalparameter_new_impl(ICAL_${uc}_PARAMETER);
 242    if (impl == 0) {
 243       return 0;
 244    }
 245
 246    icalparameter_set_${lc}((icalparameter*) impl,v);
 247    if (icalerrno != ICAL_NO_ERROR) {
 248       icalparameter_free((icalparameter*) impl);
 249       return 0;
 250    }
 251
 252    return (icalparameter*) impl;
 253 }
 254
 255 ${type} icalparameter_get_${lc}(const icalparameter* param)
 256 {
 257    icalerror_clear_errno();
 258 $charorenum
 259 }
 260
 261 void icalparameter_set_${lc}(icalparameter* param, ${type} v)
 262 {
 263    $pointer_check_v
 264    icalerror_check_arg_rv( (param!=0), "param");
 265    icalerror_clear_errno();
 266
 267    if (param->string != NULL)
 268       free (param->string);
 269    $set_code
 270 }
 271
 272 EOM
 273
 274   } elsif( $opt_h) {
 275
 276   print <<EOM;
 277 /* $param */
 278 icalparameter* icalparameter_new_${lc}($type v);
 279 ${type} icalparameter_get_${lc}(const icalparameter* value);
 280 void icalparameter_set_${lc}(icalparameter* value, ${type} v);
 281
 282 EOM
 283
 284 }
 285
 286 if ($opt_p) {
 287
 288   print <<EOM;
 289
 290 # $param
 291
 292 package Net::ICal::Parameter::${ucf};
 293 \@ISA=qw(Net::ICal::Parameter);
 294
 295 sub new
 296 {
 297    my \$self = [];
 298    my \$package = shift;
 299    my \$value = shift;
 300
 301    bless \$self, \$package;
 302
 303    my \$p;
 304
 305    if (\$value) {
 306       \$p = Net::ICal::icalparameter_new_from_string(\$Net::ICal::ICAL_${uc}_PARAMETER,\$value);
 307    } else {
 308       \$p = Net::ICal::icalparameter_new(\$Net::ICal::ICAL_${uc}_PARAMETER);
 309    }
 310
 311    \$self->[0] = \$p;
 312
 313    return \$self;
 314 }
 315
 316 sub get
 317 {
 318    my \$self = shift;
 319    my \$impl = \$self->_impl();
 320
 321    return Net::ICal::icalparameter_as_ical_string(\$impl);
 322
 323 }
 324
 325 sub set
 326 {
 327    # This is hard to implement, so I've punted for now.
 328    die "Set is not implemented";
 329 }
 330
 331 EOM
 332
 333 }
 334
 335 }
 336
 337 if ($opt_h){
 338
 339 print <<EOM;
 340 #endif /*ICALPARAMETER_H*/
 341
 342 EOM
 343 }
 344
 345 }