view release on metacpan or  search on metacpan

lib/Apache/SdnFw/lib/Core.pm  view on Meta::CPAN

	open ERR, "/usr/bin/xhtml2pdf $opts $tmpfile-$id-*.html $outfile 2>&1 |";
	while (<ERR>) {
		$err .= $_;
	}
	close ERR;

	unless (-e $outfile) {
		croak "Error creating print file $outfile\n$err";
	}

#	if ($err) {
#		croak "Error creating print file $outfile\n$err";
#	}

	`rm $tmpfile-*.html`;

	$s->{r}{file_path} = $outfile;
	$s->{r}{filename} = "$pdf_name.pdf";
	$s->{content_type} = $s->mime_type();
}

sub pdf {

=head2 pdf

 $s->pdf($pdf_name,$fname,$args);

=cut

	my $s = shift;
	my $pdf_name = shift;
	my $fname = shift;
	my $args = shift;

	my $html;

	my $tmpfile = "/tmp/$pdf_name";
	my $outfile = "/tmp/$pdf_name.pdf";

	unlink $outfile if (-e $outfile);

	my $id = time;

	if (ref $args->{pages} eq 'ARRAY') {
		my $pages = scalar @{$args->{pages}};
		#for my $i ( 0 .. $#{@{$args->{pages}}} ) {
		for my $i ( 0 .. $pages-1 ) {
			my $pg = $i+100;
			open F, ">$tmpfile-$id-$pg.html";
			print F $args->{pages}[$i];
			close F;
		}
	} else {
		$s->tt($fname, $args, \$html);
		open F, ">$tmpfile-$id-0.html";
		print F $html;
		close F;
	}

	my $opts = "--quiet --top 0.5in --bottom 0.5in --left 0.5in --right 0.5in ".
		"--webpage --bodyfont Helvetica --footer . --no-numbered ".
		"--outfile $outfile";

	my $err;
	open ERR, "/usr/bin/htmldoc $opts $tmpfile-$id-*.html 2>&1 |";
	while (<ERR>) {
		$err .= $_;
	}
	close ERR;

	unless (-e $outfile) {
		croak "Error creating print file $outfile\n$err";
	}

#	if ($err) {
#		croak "Error creating print file $outfile\n$err";
#	}

	`rm $tmpfile-*.html`;

	$s->{r}{file_path} = $outfile;
	$s->{r}{filename} = "$pdf_name.pdf";
	$s->{content_type} = $s->mime_type();
}

sub alert {

=head2 alert

 $s->alert($message,$croak);

=cut

	my $s = shift;
	my $message = shift;
	my $croak = shift;

	my $alert;

	if ($croak && !$s->{env}{DEV}) {
		# check and see if this is a common database error we just want to capture and report
		# in a different way
		if ($croak =~ m/^ERROR:\s+invalid input syntax for type date:\s+"(.+)"/) {
			$message = "'$1' is not a valid date";
			$croak = 0;
		} elsif ($croak =~ m/^ERROR:\s+null value in column "(.+)" violates not-null constraint/) {
			$message = "The database field '$1' can not be null/empty.  Is there a for field that you left blank that needed to be filled in?";
			$croak = 0;
		} elsif ($croak =~ m/^ERROR:\s+invalid input syntax for integer: "(.+)"/) {
			$message = "'$1' is not a valid integer";
			$croak = 0;
		}

	}

	if ($s->{raw_message}) {
		$s->{raw_message} .= "\n";
	}
	$s->{raw_message} .= $message;

	my $class = ($croak) ? 'alert' : 'warning';

lib/Apache/SdnFw/lib/Core.pm  view on Meta::CPAN

	if ($@) {
		return 0;
	} else {
		return 1;
	}
}

sub verify_phone {

=head2 verify_phone 

 my $truefalse = $s->verify_phone(\$number,[\$other]);

Checks that $number is only numbers and it 10 digits.  Changes
input scalar reference to clean it up.  If $other scalar reference
is provided, and nothing is in $number, then function returns true
which is somewhat of a bypass for non 10 digit phone verification.

=cut

	my $s = shift;
	my $ref = shift;
	my $other = shift;

	$$ref =~ s/\D//g;

	if (length($$ref) == 0 && defined($other)) {
		if ($$other ne '') {
			$$ref = 0;
			return 1;
		}
	}

	return 0 unless(length($$ref) == 10);

	return 1;
}

sub html_orderby {

=head2 html_orderby

 my $html = $s->html_orderby($key,[desc || asc],$params);

=cut

	my $s = shift;
	my $key = shift;
	my $direction = shift;
	my $params = shift;

	if ($s->{in}{"$key $direction"}) {
		return '';
	} elsif ($direction eq 'desc') {
		return $s->html_a("$s->{ubase}/$s->{object}/$s->{function}?ob=$key $direction&$params",'v');
	} elsif ($direction eq 'asc') {
		return $s->html_a("$s->{ubase}/$s->{object}/$s->{function}?ob=$key $direction&$params",'^');
	}
}

sub html_font {

=head2 html_font

 my $html = $s->html_font($text,$size);

=cut

	my $s = shift;
	my $text = shift;
	my $size = shift;

	return qq(<font size="$size">$text</font>);
}

sub html_a {

=head2 html_a

 my $html = $s->html_a($url,$name,[$class]);

=cut

	my $s = shift;
	my $url = shift;
	my $name = shift;
	my $class = shift;

	my $str = qq(<a href="$url");
	$str .= qq( class="$class") if ($class);
	$str .= qq(>$name</a>);

	return $str;
}

sub html_submit {

=head2 html_submit

 my $html = $s->html_submit($name,[$class]);

=cut

	my $s = shift;
	my $name = shift;
	my $class = shift;

	my $c = qq( class="$class") if ($class);

	return qq(<input type="submit" value="$name"$c>);
}

sub html_radio {

=head2 html_radio

 my $html = $s->html_radio($key,$value,[$checked],[$desc],[$id]);

=cut

	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $checked = shift;
	my $desc = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});

	my $str = qq(<input type="radio" name="$key" value="$value");
	$str .= ' checked' if ($checked eq $value);
	$str .= qq( id="$id") if ($id);
	$str .= '>';