view release on metacpan or  search on metacpan

eg/web/db/epwebapp.pl  view on Meta::CPAN

    while ($rec = $$langset -> Next)
        {
	# Check the URL

	my $lang = $rec->{id};

	foreach (@$cf)
	{
	    next unless $r->{category_types}{$_.'_'.$lang} =~ /url/;

	    if ($fdat{$_.'_'.$lang} && $fdat{$_.'_'.$lang} =~ /\s/)
	    {
		$fdat{$_.'_'.$lang} =~ s/\s//g;
		push(@{$r->{warning}}, 'warn_url_removed_white_space');
	    }

	    if ($fdat{$_.'_'.$lang} && $fdat{$_.'_'.$lang} !~ m{http://})
	    {
		$fdat{$_.'_'.$lang} =~ s{^}{http://};
		push(@{$r->{warning}}, 'warn_url_added_http');
	    }

	}

        $$txtset -> Insert ({ (map { $_ => $fdat{$_.'_'.$lang} || $fdat{$_} } @$cf),
			      "${tt}_id"  => $id,
                              language_id => $lang })
	    if (grep { $fdat{$_.'_'.$lang} || $fdat{$_} } @$cf) ;
        }

    $fdat{"${tt}_id"} = $id ;

    $r->{item_set} = undef ;
    $self->get_item_lang($r);

    if (!$udat{user_admin})
        {
	my @errors;
	my $newitemmail = Embperl::Mail::Execute ({
	    inputfile => 'updateditem.mail',
	    from => $r->{config}->{emailfrom},
	    to => $r->{config}->{adminemail},
	    subject => 'New item on Embperl Website (Category '.$r->{category_set}{category}.')'.($udat{user_email}?" by $udat{user_email}":''),
	    errors => \@errors});
	if ($newitemmail)
            {
	    $r->{error} = 'err_item_admin_mail';
	    $r->{error_details} = join("\n",@errors);

	    return;
            }
        }

    $r->{success} = 'suc_item_created';

    return $self -> redir_to_show ($r) ;
    }

# ----------------------------------------------------------------------------

sub update_item
    {
    my $self     = shift ;
    my $r        = shift ;

    die "No category" if (!defined ($r->{category_set}{edit_level})) ;

    if ($self -> checkuser($r) < $r->{category_set}{edit_level})
        {
        $r -> {need_login} = 1 ;
        return ;
        }

    my $tt = $r->{category_set}{table_type};
    my $cf = $r->{category_fields};
    my $cfnl = $r->{category_fields_nolang};

    # make sure we have an id
    if (!$fdat{"${tt}_id"})
        {
	$r -> {error} = 'err_cannot_update_no_id';
        return ;
        }

    my $set = DBIx::Recordset -> Setup  ({'!DataSource' => $r -> {db},
                                          '!Table'      => $tt }) ;

    # update the entry, but only if it has the correct user id or the has admin rights
    my $rows = $$set -> Select ({ id =>  $fdat{"${tt}_id"},
				  $r ->{user_admin} ? () : (user_id => $r->{user_id}) }) ;
    if ($rows <= 0)
        { # error if nothing was found (this will happen when the record isdn't owned by the user)
        $r -> {error} = 'err_cannot_update_maybe_wrong_user' ;
        return ;
        }

    $$set -> Update ({ url => $fdat{url},
				   (map { $_ => $fdat{$_} } @$cfnl),
				  $fdat{modtime} ? (modtime  => $fdat{modtime}) : (),
				  $fdat{category_id} ? (category_id  => $fdat{category_id}) : (),
				  $r->{user_admin}   ? (state        => $fdat{state})       : () },
				{ id => $fdat{"${tt}_id"},
				  $r ->{user_admin} ? () : (user_id => $r->{user_id}) }) ;


    my $id = $fdat{"${tt}_id"} ;
    my $langset = $r -> {language_set} ;
    my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
                                            '!Table'      => "${tt}text"}) ;

    if (DBIx::Recordset->LastError)
        {
	$r -> {error} = 'err_update_db' ;
	return ;
        }

    # Update the texts for every languange, but only if they belong to
    # the item we have updated above

    $$langset -> Reset ;
    while ($rec = $$langset -> Next)

eg/web/db/epwebapp.pl  view on Meta::CPAN

    $$set -> Reset ;
    while ($rec = $$set -> Next)
        {
        my $lang = $rec -> {language_id} ;
        $fdat{'id_' . $lang} = $rec -> {id};
        foreach my $type (@$cf)
            {
            $fdat{$type . '_' . $lang} = $rec -> {$type} ;
            }
        foreach my $type (@$cfnl)
            {
            $fdat{$type} = $rec -> {$type} ;
            }
        }

    $$set -> Reset ;
    $r -> {edit} = 1 ;
    }


# ----------------------------------------------------------------------------

sub get_user
    {
    my $self     = shift ;
    my $r        = shift ;

    $fdat{user_id} = undef unless $r -> {user_admin};

    $r -> {user_set} = DBIx::Recordset -> Search ({'!DataSource'  => $r->{db},
						   '!Table'       => "user",
						   id => $fdat{user_id} || $udat{user_id}
						   }) ;
    $r->{user_set} = undef unless ${$r->{user_set}}->MoreRecords;
    }

# ----------------------------------------------------------------------------

sub get_users
    {
    my $self     = shift ;
    my $r        = shift ;

    if ($self -> checkuser_light($r) < 1)
        {
        $r -> {need_login} = 1 ;
        return ;
        }

    return unless $r -> {user_admin};

    $r -> {users} = DBIx::Recordset -> Search ({'!DataSource'  => $r->{db},
						   '!Table'       => "user" }) ;
    $r->{users} = undef unless ${$r->{users}}->MoreRecords;
    }


# ----------------------------------------------------------------------------

sub update_user
    {
    my $self     = shift ;
    my $r        = shift ;

    if ($self -> checkuser_light($r) < 1)
        {
        $r -> {need_login} = 1 ;
        return ;
        }

    unless (($fdat{user_id} == $udat{user_id}) or $r->{user_admin})
	{
	$r->{error} = 'err_cannot_update_wrong_user_xxx';
	return;
	}

    eval { *set = DBIx::Recordset -> Update ({'!DataSource'  => $r->{db},
					      '!Table'       => "user",
					      'user_name' => $fdat{user_name},
					      'pid'  => $fdat{pid} },
					     { id => $fdat{user_id} || $udat{user_id}}) ; };


    if ($@ and $@ =~ 'Duplicate entry')
	{
	$r->{error} = 'err_pid_exists';
	return;
	}

    if (DBIx::Recordset->LastError)
	{
	$r->{error} = 'err_update_db';
	push(@{$r->{error_details}}, DBIx::Recordset->LastError
	     );
	}

    $r->{success} = 'suc_user_update';

    }

# ----------------------------------------------------------------------------
# Warning: This will not yet work as intended if there is more than
# one category using $table as category type!

sub get_title
    {
    my ($self, $r, $col, $id) = @_;

    (my $table = $col) =~ s/_id$// or die "Can't strip '_id' (col=$col)";

    my $config = $r->{config};
    my $db = DBIx::Database -> new ({'!DataSource' => $config -> {dbdsn},
                                     '!Username'   => $config -> {dbuser},
                                     '!Password'   => $config -> {dbpassword},
                                     '!DBIAttr'    => { RaiseError => 1, PrintError => 1, LongReadLen => 32765, LongTruncOk => 0, }});


    # SQL can't handle such kind soft links, so we need two requests
    *fields = DBIx::Recordset -> Search ({'!DataSource'  => $db,
					  '!Table'       => 'category, categoryfields',