#!/usr/local/bin/perl use Getopt::Std; getopts('chsypmi:'); # ARG 0 is prop-to-value open(PV,"$ARGV[0]") || die "Can't open prop to value file $ARGV[0]:$!"; while (<PV>){ chop; my @v = split(/\s+/,$_); my $prop = shift @v; my $value = shift @v; my $comment = join(" ",@v); $propmap{$prop} = $value; } close PV; # ARG 1 is value-c-types.txt open(F,"$ARGV[1]") || die "Can't open C parameter types file $ARGV[1 ]:$!"; while (<F>){ chop; my @v = split(/\t+/,$_); my $value = shift @v; my $type = shift @v; my $comment = join(" ",@v); $valuemap{$value} = $type; } close F; # Write the file inline by copying everything before a demarcation # line, and putting the generated data after the demarcation if ($opt_i) { open(IN,$opt_i) || die "Can't open input file $opt_i"; while(<IN>){ if (/Do not edit/){ last; } print; } print "/* Everything below this line is machine generated. Do not edit. */\n"; } if ( ($opt_h or $opt_s) and !$opt_i ){ print <<EOM; /* -*- Mode: C -*- ====================================================================== FILE: icalderivedproperties.{c,h} CREATOR: eric 09 May 1999 \044Id:\044 (C) COPYRIGHT 1999 Eric Busboom http://www.softwarestudio.org The contents of this file are subject to the Mozilla Public License Version 1.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. ======================================================================*/ /* * THIS FILE IS MACHINE GENERATED. DO NOT EDIT */ EOM } if ($opt_p and !$opt_i){ print <<EOM; EOM } foreach $prop (keys %propmap) { next if !$prop; my $value = $propmap{$prop}; if (!$value){ die "Can't find value for property \"$prop\"\n"; } my $ucf = join("",map {ucfirst(lc($_));} split(/-/,$prop)); my $lc = lc($ucf); my $uc = uc($lc); my $ucfvalue = join("",map {ucfirst(lc($_));} split(/-/,$value)); my $lcvalue = lc($ucfvalue); my $ucvalue = uc($lcvalue); my $type = $valuemap{$value}; my $pointer_check; if ($type =~ /\*/){ $pointer_check = "icalerror_check_arg_rz( (v!=0),\"v\");\n" if $type =~ /\*/; } elsif ( $type eq "void" ){ $pointer_check = "icalerror_check_arg_rv( (v!=0),\"v\");\n" if $type =~ /\*/; } my $set_pointer_check = "icalerror_check_arg_rv( (v!=0),\"v\");\n" if $type =~ /\*/; if($opt_c) { # Generate C source print<<EOM; /* $prop */ icalproperty* icalproperty_new_${lc}($type v) { struct icalproperty_impl *impl = icalproperty_new_impl(ICAL_${uc}_PROPERTY); $pointer_check icalproperty_set_${lc}((icalproperty*)impl,v); return (icalproperty*)impl; } icalproperty* icalproperty_vanew_${lc}($type v, ...) { va_list args; struct icalproperty_impl *impl = icalproperty_new_impl(ICAL_${uc}_PROPERTY); $pointer_check icalproperty_set_${lc}((icalproperty*)impl,v); va_start(args,v); icalproperty_add_parameters(impl, args); va_end(args); return (icalproperty*)impl; } void icalproperty_set_${lc}(icalproperty* prop, $type v) { icalvalue *value; $set_pointer_check icalerror_check_arg_rv( (prop!=0),"prop"); value = icalvalue_new_${lcvalue}(v); icalproperty_set_value(prop,value); } $type icalproperty_get_${lc}(icalproperty* prop) { icalvalue *value; icalerror_check_arg( (prop!=0),"prop"); value = icalproperty_get_value(prop); return icalvalue_get_${lcvalue}(value); } EOM } elsif ($opt_h) { # Generate C Header file print<<EOM; /* $prop */ icalproperty* icalproperty_new_${lc}($type v); icalproperty* icalproperty_vanew_${lc}($type v, ...); void icalproperty_set_${lc}(icalproperty* prop, $type v); $type icalproperty_get_${lc}(icalproperty* prop); EOM } elsif ($opt_s) { # Generate case in a switch statement print <<EOM; case ICAL_${uc}_PROPERTY: EOM } elsif ($opt_p) { # Generate perl code print <<EOM; package Net::ICal::Property::${ucf}; use Net::ICal::Property; \@ISA=qw(Net::ICal::Property); sub new { my \$package = shift; my \$p = Net::ICal::icalproperty_new(\$Net::ICal::ICAL_${uc}_PROPERTY); my \$self = Net::ICal::Property::new_from_ref(\$p); \$self->_add_elements(\\\@_); return bless \$self, \$package; } sub set_value { my \$self = shift; my \$v = shift; my \$impl = \$self->_impl(); if ( ref \$v && Net::ICal::icalvalue_isa_value(\$v->_impl())){ Net::ICal::icalproperty_set_value(\$impl,\$v->_impl); } else { my \$value = Net::ICal::icalvalue_new_from_string(\$Net::ICal::ICAL_${ucvalue}_VALUE,\$v); die if !\$impl; Net::ICal::icalproperty_set_value(\$impl,\$value) unless !\$value; } } sub get_value { my \$self = shift; my \$impl = \$self->_impl(); if (defined \$impl){ my \$value = Net::ICal::icalproperty_get_value(\$impl); return "" if !\$value; return Net::ICal::icalvalue_as_ical_string(\$value); } else { return ""; } } EOM } elsif ($opt_m) { # Generate a map print "\'${uc}\' => \'Net::ICal::Property::${ucf},\'\n"; } } # This brace terminates the main loop # Add things to the end of the output. if ($opt_p) { print "1;\n"; } if ($opt_h){ print <<EOM; #endif ICALPROPERTY_H EOM }