view release on metacpan or  search on metacpan

Generator_base/Generator.pm  view on Meta::CPAN

package QWizard::Generator;

use AutoLoader;
use POSIX qw(isprint);
use strict;
our $VERSION = '3.15';
use QWizard::Storage::Memory;
require Exporter;
use File::Temp qw(tempfile);
use IO::File;

@QWizard::Generator::ISA = qw(Exporter);
@QWizard::Generator::EXPORT = qw(qwdebug qwpref);

our $AUTOLOAD;

# just a base class.
#
# functions to implement:
#  radio

# default do-nothing subroutines.  These are optional in sub-generators.
sub do_question_end {}
sub start_questions {}
sub end_questions {}
sub do_pass {};

sub new {
    die "should not be called directly\n";
}

sub init_default_storage {
    my $self = shift;
    $self->{'datastore'} = new QWizard::Storage::Memory();
    $self->{'prefstore'} = new QWizard::Storage::Memory();
    $self->{'tmpdir'} = "/tmp" if (!$self->{'tmpdir'});
}

# widgets that have fallbacks to more minimal widgets:
sub do_textbox {
    my $self = shift;
    $self->do_entry(@_);
}

sub do_paragraph {
    my $self = shift;
    $self->do_label(@_);
}

our $have_gd_graph = eval { require GD::Graph::lines; };
our $have_chart_graph = eval { require Chart::Lines; };

our $def_width = 400;
our $def_height = 400;

#
# returns a quantized X dataset from a sorted but non-linear x dataset
#
# INPUT points:
#   [[X1, Y1],[X2, Y2]]
# OUTPUT quantized WIDTH number of buckets:
#   [[min(X1), Y1], [min(X1)+(maxx-minx)/WIDTH, YJ]]
#
sub binize_x_data {
    my ($self, $multidata, $q, $width) = @_;
    my ($minx, $maxx);

    my ($newdata, $x, $xlab);

    if (!$q->{'multidata'}) {
	$multidata = [$multidata];
    }

    #  calculates min and max X values from the datasets
    foreach my $data (@$multidata) {
	if (!defined($minx) || $minx > $data->[0][0]) {
	    $minx = $data->[0][0];
	}
	if (!defined($maxx) || $maxx < $data->[$#$data][0]) {
	    $maxx = $data->[$#$data][0];
	}
    }
    my $diff = $maxx - $minx;
    if ($diff == 0) {
	print STDERR "no data to graph (time diff = 0)!\n";
	print STDERR "minx: $minx, maxx: $maxx\n";
	return [[]];
    }
    my $addative = 0;
    foreach my $data (@$multidata) {
	my $numc = $#{$data->[0]};
	foreach my $d (@$data) {
	    my $xval = int($width * (($d->[0] - $minx) / $diff));
	    if (!exists($newdata->[0][$xval])) {
		 $newdata->[0][$xval] = $d->[0];

Generator_base/Generator.pm  view on Meta::CPAN

    for (my $i = 0; $i <= $#$argdef; $i++) {
	if (ref($argdef->[$i]) ne 'ARRAY') {
	    print STDERR "malformed argument definition: $argdef->[$i]\n";
	    push @args, undef;
	    next;
	}
	my $def = $argdef->[$i];
	if ($def->[0] eq 'default') {
	    push @args, $default;
	} elsif ($def->[0] eq 'forced') {
	    push @args, $def->[1];
	} elsif ($def->[0] eq 'values,labels') {
	    push @args, $wiz->get_values_and_labels($q, $def->[1])
	} elsif ($def->[0] eq 'multi') {
	    if (exists($q->{$def->[1]})) {
		push @args, $wiz->get_values($q->{$def->[1]});
	    } else {
		push @args, $def->[2];
	    }
	} elsif ($def->[0] eq 'single') {
	    if (exists($q->{$def->[1]})) {
		push @args, $wiz->get_value($q->{$def->[1]});
	    } else {
		push @args, $def->[2];
	    }
	} elsif ($def->[0] eq 'norecurse') {
	    if (exists($q->{$def->[1]})) {
		push @args, $wiz->get_value($q->{$def->[1]}, 1);
	    } else {
		push @args, $def->[2];
	    }
	} elsif ($def->[0] eq 'norecursemulti') {
	    if (exists($q->{$def->[1]})) {
		push @args, $wiz->get_values($q->{$def->[1]}, 1);
	    } else {
		push @args, $def->[2];
	    }
	} elsif ($def->[0] eq 'labels') {
	    if (exists($q->{$def->[1]})) {
		push @args, $wiz->get_labels($q);
	    } else {
		push @args, $def->[2];
	    }
	} elsif ($def->[0] eq 'noexpand') {
	    if (exists($q->{$def->[1]})) {
		push @args, $q->{$def->[1]};
	    } else {
		push @args, $def->[2];
	    }
	} else {
	    print STDERR "unknown argument type: $def->[0]\n";
	}
    }
    return \@args;
}

# preferences

sub qwpref {
    my $self = shift;
    return $self->{'prefstore'}->access(@_);
}

# file uploads

sub qw_upload_fh {
    my ($self) = shift;
    my ($it);
    my $ret;
    if (ref($self) =~ /QWizard/) {
	$it = shift;
    } else {
	$it = $self;
    }

    my $fh = new IO::File();
    $fh->open("<" . $self->qwparam($it));

    return $fh;
}

# this is overriden by the HTML handler to return a pointer to a temp file 
sub qw_upload_file {
    my ($self) = shift;
    my ($it);
    my $ret;
    if (ref($self) =~ /QWizard/) {
	$it = shift;
    } else {
	$it = $self;
    }

    return $self->qwparam($it);
}

######################################################################
## convenience functions

sub make_displayable {
    my ($self, $str);
    if ($#_ > 0) {
	($self, $str) = @_;
    } else {
	($str) = @_;
    }

    if (defined($str) && $str ne '' && !isprint($str)) {
	$str = "0x" . (unpack("H*", $str))[0];
    }
    return $str;
}

######################################################################
## temporary file handling

sub create_temp_fh {
    my ($self, $sfx) = @_;
    mkdir($self->{'tmpdir'}) if (! -d $self->{'tmpdir'});
    my ($fh, $filename) = tempfile("qwHTMLXXXXXX", SUFFIX => $sfx,
				   DIR => $self->{'tmpdir'} || "/tmp/");
    return ($fh, $filename);