# Copyright (c) 2000-2008 bivio Software, Inc. All rights reserved. # # Visit http://www.bivio.biz for more info. # # This library is free software; you can redistribute it and/or modify # it under the terms of the GNU Lesser General Public License as # published by the Free Software Foundation; either version 2.1 of the # License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; If not, you may get a copy from: # http://www.opensource.org/licenses/lgpl-license.html # # $Id: HTTPCookies.pm,v 1.3 2011/11/05 23:44:48 nagler Exp $ package Bivio::Ext::HTTPCookies; use strict; use base 'HTTP::Cookies'; our($VERSION) = sprintf('%d.%02d', q$Revision: 1.3 $ =~ /\d+/g); my($_F) = Bivio::UNIVERSAL->use('IO.File'); my($_D) = Bivio::UNIVERSAL->use('Bivio.Die'); sub clone { my($self) = @_; my($tmp) = $_F->temp_file; my($clone); my($die) = $_D->catch( sub { $self->save($tmp); delete($self->{file}); $clone = ref($self)->new( map( ($_ => $self->{$_}), grep($_ ne 'COOKIES', keys(%$self)), ), ); $clone->load($tmp); delete($clone->{file}); return; }, ); unlink($tmp); $die->throw if $die; return $clone; } 1;