%doc>
Closet interface
%doc>
<%args>
$id => undef;
$edit => undef;
$bb_sort => undef;
$cable_sort => undef;
$pic_sort => undef;
$user => $ui->get_current_user($r)
%args>
<%flags>
%flags>
<%attr>
title => 'Closet'
section => 'Plant'
%attr>
<%init>
my $DEBUG = 0;
my $o = undef;
my $editCloset = 0;
my $editPictures = 0;
my $editBackbones = 0;
my $editHorizontal = 0;
if ( defined $id && $id ne "NEW" ){
$o = Closet->retrieve($id);
$m->comp('/generic/error.mhtml', error=>"Cannot retrieve Closet id $id")
unless $o;
}
$editCloset = 1 if ($id eq "NEW" || $edit eq "closetinfo");
$editPictures = 1 if ($edit eq "closetpictures");
$editBackbones = 1 if ($edit eq "bbinfo");
$editHorizontal = 1 if ($edit eq "cableinfo");
my (@field_headers, @cell_data); # For /generic/attribute_table.mhtml calls
my (@headers, @rows); # For /generic/data_table.mhtml calls. Aware there need not really be 4 variables.
my $manager = $ui->get_permission_manager($r);
%init>
<%perl>
print "
", Dumper(%ARGS), "
" if $DEBUG;
# code for inserting/updating
# -----------------------------------------------------------------------------
if ( defined($ARGS{_action}) && $ARGS{_action} eq "ADD_PICTURE" && defined($ARGS{__picture}) && $ARGS{__picture} ne "" ) {
eval {
use Apache2::Upload;
my $bindata;
my $upload = $r->upload("__picture");
my $upload_fh = $upload->fh;
my $size = $upload->slurp($bindata);
ClosetPicture->insert({closet=>$id, filename=>$ARGS{__picture}, bindata=>$bindata, filesize=>$size});
};
if ( my $e = $@ ){
$m->comp('/generic/error.mhtml', error=>$e);
}
}elsif ( defined($ARGS{_action}) ) {
my %update_info = ();
print "ARGS is
", Dumper(%ARGS), "
" if $DEBUG;
eval{
%update_info = $ui->form_to_db(%ARGS);
};
if ( my $e = $@ ){
$m->comp('/generic/error.mhtml', error=>$e);
}
if ( $update_info{Closet}{id} ) {
$id = (keys %{$update_info{Closet}{id}})[0];
$editCloset = 0;
}
# Do this to 'flush' the values associated with the object
# before redisplaying
$o = undef;
if ( $id && $id ne "NEW" ){
$o = Closet->retrieve($id);
}
}
# end insertion/update code
# -----------------------------------------------------------------------------
%perl>