perl-module/lib/PSPP.pm

   1 use 5.008008;
   2 use strict;
   3 use warnings;
   4
   5 do 'pspp-vers.pl' || die "No version set";
   6
   7 =head1 NAME
   8
   9 PSPP - Perl extension to PSPP
  10
  11 =head1 SYNOPSIS
  12
  13   use PSPP;
  14
  15 =head1 DESCRIPTION
  16
  17 PSPP:: provides an interface to the libraries used by pspp to create
  18 system files.
  19
  20 =head1 EXPORT
  21
  22 None by default.
  23
  24 =cut
  25
  26 require XSLoader;
  27 XSLoader::load('PSPP', $PSPP::VERSION);
  28
  29 =pod
  30
  31 =head1 PROGRAMMER'S INTERFACE
  32
  33 The subroutines in this package return zero or unref on error.
  34 When errors occur, a string describing the error is written
  35 to C<$PSPP::errstr>.
  36
  37 =cut
  38
  39 package PSPP;
  40 use POSIX ;
  41
  42 use constant { SYSMIS => -(POSIX::DBL_MAX),
  43                PERL_EPOCH => 12219379200 # Number of seconds between
  44                    # 14th October 1582
  45                    # and
  46                    # 1st January 1970
  47                };
  48
  49
  50
  51 package PSPP::Dict;
  52
  53 =pod
  54
  55 =head2 PSPP::Dict::new
  56
  57 Creates a new dictionary.  This returned dictionary will be empty.
  58 Returns undef on failure.
  59
  60 =head3 set_documents ($string)
  61
  62 Sets the documents (comments) to C<string>.
  63
  64 =head3 add_document ($string)
  65
  66 Appends C<string> to the documents.
  67
  68 =head3 clear_documents ()
  69
  70 Removes all documents.
  71
  72 =head3 set_weight ($var)
  73
  74 Sets the weighting variable to C<var>.
  75
  76 =cut
  77
  78 sub new
  79 {
  80     my $class = shift;
  81     my $self = pxs_dict_new ();
  82     bless ($self, $class);
  83     return $self;
  84 }
  85
  86 =pod
  87
  88 =head3 get_var
  89
  90 Returns a variable from a dictionary
  91
  92 =cut
  93
  94 sub get_var
  95 {
  96     my $dict = shift;
  97     my $idx = shift;
  98     my $var = pxs_get_variable ($dict, $idx);
  99
 100     if ( ref $var )
 101     {
 102         bless ($var, "PSPP::Var");
 103     }
 104     return $var;
 105 }
 106
 107
 108 package PSPP::Fmt;
 109
 110 =pod
 111
 112 =head2 PSPP::Fmt
 113
 114 Contains constants used to denote variable format types.
 115 The identifiers are the same as  those used in pspp to denote formats.
 116 For  example C<PSPP::Fmt::F> defines floating point format, and
 117 C<PSPP::Fmt::A> denotes string format.
 118
 119 =cut
 120
 121 # These must correspond to the values in src/data/format.h
 122 use constant {
 123     F =>        0,
 124     COMMA =>    1,
 125     DOT =>      2,
 126     DOLLAR =>   3,
 127     PCT =>      4,
 128     E =>        5,
 129     CCA =>      6,
 130     CCB =>      7,
 131     CCC =>      8,
 132     CCD =>      9,
 133     CCE =>      10,
 134     N =>        11,
 135     Z =>        12,
 136     P =>        13,
 137     PK =>       14,
 138     IB =>       15,
 139     PIB =>      16,
 140     PIBHEX =>   17,
 141     RB =>       18,
 142     RBHEX =>    19,
 143     DATE =>     20,
 144     ADATE =>    21,
 145     EDATE =>    22,
 146     JDATE =>    23,
 147     SDATE =>    24,
 148     QYR =>      25,
 149     MOYR =>     26,
 150     WKYR =>     27,
 151     DATETIME => 28,
 152     TIME =>     29,
 153     DTIME =>    30,
 154     WKDAY =>    31,
 155     MONTH =>    32,
 156     A =>        33,
 157     AHEX =>     34
 158 };
 159
 160
 161 =head2 PSPP::Var
 162
 163 =cut
 164
 165 package PSPP::Var;
 166
 167 =head3 new ($dict, $name, %input_fmt)
 168
 169 Creates and returns a new variable in the dictionary C<dict>.  The
 170 new variable will have the name C<name>.
 171 The input format is set by the C<input_fmt> parameter
 172 (See L</PSPP::Fmt>).
 173 By default, the write and print formats are the same as the input format.
 174 The write and print formats may be changed (See L</set_write_format>),
 175 L</set_print_format>).  The input format may not be changed after
 176 the variable has been created.
 177 If the variable cannot be created, undef is returned.
 178
 179 =cut
 180
 181 sub new
 182 {
 183     my $class = shift;
 184     my $dict = shift;
 185     my $name = shift;
 186     my %format = @_;
 187     my $self = pxs_dict_create_var ($dict, $name, \%format);
 188     if ( ref $self )
 189     {
 190         bless ($self, $class);
 191     }
 192     return $self;
 193 }
 194
 195 =pod
 196
 197 =head3 set_label ($label)
 198
 199 Sets the variable label to C<label>.
 200
 201
 202 =cut
 203
 204 =pod
 205
 206 =head3 set_write_format (%fmt)
 207
 208 Sets the write format to C<fmt>. <fmt> is a hash containing the keys:
 209
 210 =over 2
 211
 212 =item FMT
 213
 214 A constant denoting the format type.  See L</PSPP::Fmt>.
 215
 216 =item decimals
 217
 218 An integer denoting the number of decimal places for the format.
 219
 220 =item width
 221
 222 An integer denoting the number of width of the format.
 223
 224 =back
 225
 226 On error the subroutine returns zero.
 227
 228 =cut
 229
 230 sub set_write_format
 231 {
 232     my $var = shift;
 233     my %format = @_;
 234     pxs_set_write_format ($var, \%format);
 235 }
 236
 237 =pod
 238
 239 =head3 set_print_format (%fmt)
 240
 241 Sets the print format to C<fmt>.
 242 On error the subroutine returns zero.
 243
 244 =cut
 245
 246 sub set_print_format
 247 {
 248     my $var = shift;
 249     my %format = @_;
 250     pxs_set_print_format ($var, \%format);
 251 }
 252
 253 =pod
 254
 255 =head3 set_output_format (%fmt)
 256
 257 Sets the write and print formats to C<fmt>.  This is the same as
 258 calling set_write_format followed by set_print_format.
 259 On error the subroutine returns zero.
 260
 261 =cut
 262
 263
 264 sub set_output_format
 265 {
 266     my $var = shift;
 267     my %format = @_;
 268     pxs_set_output_format ($var, \%format);
 269 }
 270
 271 =pod
 272
 273 =head3 clear_value_labels ()
 274
 275 Removes all value labels from the variable.
 276
 277 =cut
 278
 279
 280 =pod
 281
 282 =head3 add_value_label ($key, $label)
 283
 284 Adds the value label C<label> to the variable for the value C<key>.
 285 On error the subroutine returns zero.
 286
 287 =head3 add_value_labels (@array)
 288
 289 =cut
 290
 291 sub add_value_labels
 292 {
 293     my $var = shift;
 294     my %values = @_;
 295     my @li;
 296
 297     my $n = 0;
 298     while ( @li = each %values )
 299     {
 300         if ( $var->add_value_label ($li[0], "$li[1]") )
 301         {
 302             $n++;
 303         }
 304     }
 305
 306     return $n;
 307 }
 308
 309 =pod
 310
 311 =head3 set_value_labels ($key, $value)
 312
 313 C<Set_value_labels> is identical to calling L</clear_value_labels>
 314 followed by L</add_value_labels>.
 315 On error the subroutine returns zero.
 316
 317 =cut
 318
 319 sub set_value_labels
 320 {
 321     my $self = shift;
 322     my %labels = @_;
 323     $self->clear_value_labels () ;
 324     $self->add_value_labels (%labels);
 325 }
 326
 327 =pod
 328
 329 =head3 set_missing_values ($val1 [, $val2[, $val3] ])
 330
 331 Sets the missing values for the variable.
 332 No more than three missing values may be specified.
 333
 334 =cut
 335
 336
 337 package PSPP::Sysfile;
 338
 339 =pod
 340
 341 =head2 PSPP::Sysfile
 342
 343 =head3 new ($filename, $dict [,%opts])
 344
 345 Creates a new system file from the dictionary C<dict>.  The file will
 346 be written to the file called C<filename>.
 347 C<opt>, if specified, is a hash containing optional parameters for the
 348 system file.  Currently, the only supported parameter is
 349 C<compress>. If C<compress> is non zero, then the system file written
 350 will be in the compressed format.
 351 On error, undef is returned.
 352
 353
 354 =head3 append_case (@case)
 355
 356 Appends a case to the system file.
 357 C<Case> is an array of scalars, each of which are the values of
 358 the variables in the dictionary corresponding to the system file.
 359 The special value C<PSPP::SYSMIS> may be used to indicate that a value
 360 is system missing.
 361 If the array contains less elements than variables in the dictionary,
 362 remaining values will be set to system missing.
 363
 364 =cut
 365
 366 sub new
 367 {
 368     my $class = shift;
 369     my $filename = shift;
 370     my $dict = shift;
 371     my $opts = shift;
 372
 373     my $self  = pxs_create_sysfile ($filename, $dict, $opts);
 374
 375     if ( ref $self )
 376     {
 377         bless ($self, $class);
 378     }
 379     return $self;
 380 }
 381
 382 =pod
 383
 384 =head3 close ()
 385
 386 Closes the system file.
 387
 388 This subroutine closes the system file and flushes it to disk.  No
 389 further cases may be written once the file has been closed.
 390 The system file will be automatically closed when it goes out of scope.
 391
 392 =cut
 393
 394 package PSPP::Reader;
 395
 396 sub open
 397 {
 398     my $class = shift;
 399     my $filename = shift;
 400
 401     my $self  = pxs_open_sysfile ($filename);
 402
 403     if ( ref $self )
 404     {
 405         bless ($self, $class);
 406     }
 407     return $self;
 408 }
 409
 410
 411 sub get_dict
 412 {
 413     my $reader = shift;
 414
 415     my $dict = pxs_get_dict ($reader);
 416
 417     bless ($dict, "PSPP::Dict");
 418
 419     return $dict;
 420 }
 421
 422
 423
 424 1;
 425 __END__
 426
 427
 428 =head1 AUTHOR
 429
 430 John Darrington, E<lt>john@darrington.wattle.id.auE<gt>
 431
 432 =head1 COPYRIGHT AND LICENSE
 433
 434 Copyright (C) 2007 by Free Software Foundation
 435
 436    This program is free software; you can redistribute it and/or
 437    modify it under the terms of the GNU General Public License as
 438    published by the Free Software Foundation; either version 2 of the
 439    License, or (at your option) any later version.
 440
 441    This program is distributed in the hope that it will be useful, but
 442    WITHOUT ANY WARRANTY; without even the implied warranty of
 443    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 444    General Public License for more details.
 445
 446    You should have received a copy of the GNU General Public License
 447    along with this program; if not, write to the Free Software
 448    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 449    02110-1301, USA.
 450
 451 =cut