view release on metacpan or  search on metacpan

lib/Beagle/Backend/base.pm  view on Meta::CPAN

    }

    my $type = $args{type} || 'article';

    my %file;

    if ( $type eq 'attachment' ) {
        my $encoded_root = catdir( $encoded_root, 'attachments' );
        return unless -e $encoded_root;

        opendir my $dh, $encoded_root or die $!;

        while ( my $dir = readdir $dh ) {
            if ( $dir =~ /^\w{2}$/ ) {
                opendir my $dh2, catdir( $encoded_root, $dir )
                  or die $!;
                while ( my $left = readdir $dh2 ) {
                    if ( $left =~ /^\w{30}$/ ) {
                        opendir my $dh3, catdir( $encoded_root, $dir, $left )
                          or die $!;

                        $file{ $dir . $left } = [
                            map { decode( locale_fs => $_ ) }
                            grep { $_ ne '.' && $_ ne '..' } readdir $dh3
                        ];
                    }
                }
            }
        }
        return %file;
    }
    else {
        require Lingua::EN::Inflect;
        my $root = catdir( $encoded_root, Lingua::EN::Inflect::PL($type) );
        return unless -e $root;

        opendir my $dh, $root or die $!;

        while ( my $dir = readdir $dh ) {
            next unless $dir =~ /^\w{2}$/;
            opendir my $dh2, catdir( $root, $dir )
              or die $!;
            while ( my $left = readdir $dh2 ) {
                next unless $left =~ /^\w{30}$/;
                my $path = catfile( $root, $dir, $left );
                next unless -f $path;
                local $/;
                open my $fh, '<', $path or die $!;
                binmode $fh;
                $path =~ s!^\Q$top_encoded_root\E[/\\]?!!;
                $file{ $dir . $left } = {
                    path    => decode( locale_fs => $path ),
                    content => decode_utf8 <$fh>,
                };
            }
        }
    }
    return %file;
}

sub update {
    my $self   = shift;
    my $object = shift;
}

sub delete {
    my $self   = shift;
    my $object = shift;
}

sub updated {
    my $self = shift;
}

no Any::Moose;
__PACKAGE__->meta->make_immutable;

1;
__END__


=head1 AUTHOR

    sunnavy <sunnavy@gmail.com>


=head1 LICENCE AND COPYRIGHT

    Copyright 2011 sunnavy@gmail.com

    This program is free software; you can redistribute it and/or modify it
    under the same terms as Perl itself.